[paparazzi-commits] [4783] add check for duplited ids, warning for unsorted ids

[Pascal Brisset]

Revision: 4783
          http://svn.sv.gnu.org/viewvc/?view=rev&root=paparazzi&revision=4783
Author:   hecto
Date:     2010-04-02 11:23:40 +0000 (Fri, 02 Apr 2010)
Log Message:
-----------
 add check for duplited ids, warning for unsorted ids

Modified Paths:
--------------
    paparazzi3/trunk/sw/tools/gen_messages.ml

Modified: paparazzi3/trunk/sw/tools/gen_messages.ml
===================================================================
--- paparazzi3/trunk/sw/tools/gen_messages.ml   2010-04-02 11:00:23 UTC (rev 
4782)
+++ paparazzi3/trunk/sw/tools/gen_messages.ml   2010-04-02 11:23:40 UTC (rev 
4783)
@@ -84,13 +84,27 @@
          (_type, id, fmt))
        (Xml.children xml) in 
     { id=id; name = name; period = period; fields = fields }
+
+  let check_single_ids = fun msgs ->
+    let tab = Array.create 256 false
+    and  last_id = ref 0 in
+    List.iter (fun msg ->
+      if tab.(msg.id) then
+        failwith (sprintf "Duplicated message id: %d" msg.id);
+      if msg.id < !last_id then
+        fprintf stderr "Warning: unsorted id: %d\n%!" msg.id;
+      last_id := msg.id;
+      tab.(msg.id) <- true)
+      msgs
          
   (** Translates one class of a XML message file into a list of messages *)
   let read = fun filename class_ ->
     let xml = Xml.parse_file filename in
     try
       let xml_class = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = 
class_) xml "class" in
-      List.map struct_of_xml (Xml.children xml_class)
+      let msgs = List.map struct_of_xml (Xml.children xml_class) in
+      check_single_ids msgs;
+      msgs
     with
       Not_found -> failwith (sprintf "No class '%s' found" class_)
 end (* module Suntax *)