Ocaml 405 fix (#2221)

* Fixed string related build warnings
* Changed Failures to accept all strings
* Updated pprzlink for v405 fix
* updated use of lowercase, uppercase and capitalize

sw/ground_segment/cockpit/gcs.ml

@@ -499,7 +499,7 @@ let resize = fun (widget:GObj.widget) orientation size ->
 
 let rec pack_widgets = fun orientation xml widgets packing ->
   let size = try Some (ExtXml.int_attrib xml "size") with _ -> None in
-  match Compat.bytes_lowercase (Xml.tag xml) with
+  match Compat.lowercase_ascii (Xml.tag xml) with
       "widget" ->
         let name = ExtXml.attrib xml "name" in
         let widget =
@@ -526,7 +526,7 @@ and pack_list = fun resize orientation xmls widgets packing ->
 
 let rec find_widget_children = fun name xml ->
   let xmls = Xml.children xml in
-  match Compat.bytes_lowercase (Xml.tag xml) with
+  match Compat.lowercase_ascii (Xml.tag xml) with
       "widget" when ExtXml.attrib xml "name" = name -> xmls
     | "rows" | "columns" ->
       let rec loop = function
@@ -540,7 +540,7 @@ let rec find_widget_children = fun name xml ->
 
 let rec replace_widget_children = fun name children xml ->
   let xmls = Xml.children xml
-  and tag = Compat.bytes_lowercase (Xml.tag xml) in
+  and tag = Compat.lowercase_ascii (Xml.tag xml) in
   match tag with
       "widget" ->
         Xml.Element("widget",
@@ -562,7 +562,7 @@ let rec update_widget_size = fun orientation widgets xml ->
     if orientation = `HORIZONTAL then rect.Gtk.width else rect.Gtk.height
   in
   let xmls = Xml.children xml
-  and tag = Compat.bytes_lowercase (Xml.tag xml) in
+  and tag = Compat.lowercase_ascii (Xml.tag xml) in
   match tag with
       "widget" ->
         let name = ExtXml.attrib xml "name" in

sw/ground_segment/cockpit/live.ml

@@ -348,7 +348,7 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame ->
 let attributes_pretty_printer = fun attribs ->
   (* Remove the optional attributes *)
   let valid = fun a ->
-    let a = Compat.bytes_lowercase a in
+    let a = Compat.lowercase_ascii a in
     a <> "no" && a <> "strip_icon" && a <> "strip_button" && a <> "pre_call"
     && a <> "post_call" && a <> "key" && a <> "group" in
 

sw/ground_segment/cockpit/page_settings.ml

@@ -55,7 +55,7 @@ object
           let v = float_of_string s in
           last_known_value <- Some v;
           set_default v
-        with Failure "float_of_string" -> ()
+        with Failure _ -> ()
       end
 end
 
@@ -249,7 +249,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
 
   (** Insert the related buttons in the strip and prepare the papgets DnD *)
   List.iter (fun x ->
-    match Compat.bytes_lowercase (Xml.tag x) with
+    match Compat.lowercase_ascii (Xml.tag x) with
         "strip_button" ->
           let label = ExtXml.attrib x "name"
           and sp_value = ExtXml.float_attrib x "value"
@@ -293,7 +293,7 @@ let same_tag_for_all = function
   | x::xs ->
     let tag_first = Xml.tag x in
     List.iter (fun y -> assert(ExtXml.tag_is y tag_first)) xs;
-    Compat.bytes_lowercase tag_first
+    Compat.lowercase_ascii tag_first
 
 
 (** Build the tree of settings *)

sw/ground_segment/cockpit/saveSettings.ml

@@ -170,7 +170,7 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml ->
         try
           float_of_string (List.hd str_val) *. airframe_scale *. extra_scale
         with
-            Failure "float_of_string" -> raise (EditAirframe.No_param param)
+            Failure _ -> raise (EditAirframe.No_param param)
       in
       let airframe_value_new = value /. airframe_scale in
       (* test if is has to be saved as integer or float *)

sw/ground_segment/cockpit/sectors.ml

@@ -7,7 +7,7 @@ let (//) = Filename.concat
 
 let rec display = fun (geomap:MapCanvas.widget) r ->
 
-  match Compat.bytes_lowercase (Xml.tag r) with
+  match Compat.lowercase_ascii (Xml.tag r) with
       "disc" ->
         let rad = float_of_string (ExtXml.attrib r "radius")
         and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in

sw/ground_segment/tmtc/messages.ml

@@ -164,7 +164,7 @@ let one_page = fun sender class_name (notebook:GPack.notebook) (topnote:GPack.no
       eb#coerce#misc#set_state `SELECTED;
       ignore (GMain.Timeout.add led_delay (fun () -> eb#coerce#misc#set_state `NORMAL; false))
     with
-        Invalid_argument "List.iter2" ->
+        Invalid_argument _ ->
           Printf.fprintf stderr "%s: expected %d args, got %d\n" id n (List.length values); flush stderr
       | exc -> prerr_endline (Printexc.to_string exc)
   in

sw/ground_segment/tmtc/server_globals.ml

@@ -24,7 +24,7 @@ let string_of_values = fun values ->
 (** get modes from autopilot xml file *)
 let modes_from_autopilot = fun ap_xml ->
   let ap = ExtXml.child ap_xml
-    ~select:(fun x -> String.uppercase (ExtXml.attrib_or_default x "gcs_mode" "") = "TRUE")
+    ~select:(fun x -> Compat.uppercase_ascii (ExtXml.attrib_or_default x "gcs_mode" "") = "TRUE")
     "state_machine"
   in
   let modes = List.filter (fun x -> Xml.tag x = "mode") (Xml.children ap) in

sw/lib/ocaml/Makefile

@@ -71,6 +71,9 @@ ifeq ($(shell test $(OCAMLC_MAJOR) -ge 4; echo $$?),0)
 ifeq ($(shell test $(OCAMLC_MINOR) -ge 2; echo $$?),0)
 # the Bytes module is available since OCaml 4.02.0
 CAMLP4_DEFS += -DHAS_BYTES_MODULE
+ifeq ($(shell test $(OCAMLC_MINOR) -ge 4; echo $$?),0)
+CAMLP4_DEFS += -DOCAML_V404
+endif
 endif
 endif
 PP_OPTS = -pp "camlp4o pa_macro.cmo $(CAMLP4_DEFS)"

sw/lib/ocaml/compat.ml

@@ -43,12 +43,6 @@ let bytes_make = fun n c->
 let bytes_copy = fun s->
   BYTES.copy s
 
-let bytes_lowercase = fun s->
-  BYTES.lowercase s
-
-let bytes_uppercase = fun s->
-  BYTES.uppercase s
-
 let bytes_blit = fun src srcoff dst dstoff len->
   BYTES.blit src srcoff dst dstoff len
 
@@ -75,3 +69,19 @@ let bytes_set = fun s n c->
 
 let bytes_iter = fun f s->
   BYTES.iter f s
+
+IFDEF OCAML_V404 THEN
+let lowercase_ascii = BYTES.lowercase_ascii
+
+let uppercase_ascii = BYTES.uppercase_ascii
+
+let capitalize_ascii = BYTES.capitalize_ascii
+
+ELSE
+let lowercase_ascii = BYTES.lowercase
+
+let uppercase_ascii = BYTES.uppercase
+
+let capitalize_ascii = BYTES.capitalize
+
+END

sw/lib/ocaml/compat.mli

@@ -27,8 +27,6 @@ val bytes_contains : string -> char -> bool
 val bytes_length : string -> int
 val bytes_make : int -> char -> string
 val bytes_copy : string -> string
-val bytes_lowercase : string -> string
-val bytes_uppercase : string -> string
 val bytes_blit : string -> int -> string -> int -> int -> unit
 val bytes_sub : string -> int -> int -> string
 val bytes_index : string -> char -> int
@@ -38,3 +36,7 @@ val bytes_get : string -> int -> char
 val bytes_compare : string -> string -> int
 val bytes_set : string -> int -> char -> unit
 val bytes_iter : (char -> unit) -> string -> unit
+
+val lowercase_ascii : string -> string
+val uppercase_ascii : string -> string
+val capitalize_ascii : string -> string

sw/lib/ocaml/expr_lexer.mll

@@ -63,7 +63,7 @@ rule token = parse
     try
       Expr_parser.expression token lexbuf
     with
-      Failure("lexing: empty token") ->
+      Failure _ ->
 	Printf.fprintf stderr "Lexing error in '%s': unexpected char: '%c' \n"
 	  s (Lexing.lexeme_char lexbuf 0);
 	exit 1

sw/lib/ocaml/extXml.ml

@@ -44,7 +44,7 @@ let child = fun xml ?select c ->
 
   (* Let's try with a numeric index *)
   try (Array.of_list children).(int_of_string c)
-  with Failure "int_of_string" -> (* Bad luck. Go through the children *)
+  with Failure _ -> (* Bad luck. Go through the children *)
     find children
 
 
@@ -75,7 +75,7 @@ let attrib_option = fun xml attr ->
   try Some (Xml.attrib xml attr)
   with Xml.No_attribute _ -> None
 
-let tag_is = fun x v -> Compat.bytes_lowercase (Xml.tag x) = Compat.bytes_lowercase v
+let tag_is = fun x v -> Compat.lowercase_ascii (Xml.tag x) = Compat.lowercase_ascii v
 
 let attrib_or_default = fun x a default ->
   try Xml.attrib x a
@@ -148,7 +148,7 @@ let my_to_string_fmt = fun tab_attribs x ->
 
 
 let to_string_fmt = fun ?(tab_attribs = false) xml ->
-  let l = Compat.bytes_lowercase in
+  let l = Compat.lowercase_ascii in
   let rec lower = function
     | Xml.PCData _ as x -> x
     | Xml.Element (t, ats, cs) ->
@@ -159,7 +159,7 @@ let to_string_fmt = fun ?(tab_attribs = false) xml ->
 
 
 let subst_attrib = fun attrib value xml ->
-  let u = Compat.bytes_uppercase in
+  let u = Compat.uppercase_ascii in
   let uattrib = u attrib in
   match xml with
   | Xml.Element (tag, attrs, children) ->

sw/lib/ocaml/fp_proc.ml

@@ -38,7 +38,7 @@ let parse_expression = fun s ->
   try
     Expr_parser.expression Expr_lexer.token lexbuf
   with
-      Failure("lexing: empty token") ->
+      Failure _ ->
         fprintf stderr "Lexing error in '%s': unexpected char: '%c' \n"
           s (Lexing.lexeme_char lexbuf 0);
         exit 1
@@ -72,7 +72,7 @@ let transform_values = fun attribs_not_modified env attribs ->
   List.map
     (fun (a, v) ->
       let v' =
-        if List.mem (String.lowercase a) attribs_not_modified
+        if List.mem (Compat.lowercase_ascii a) attribs_not_modified
         then v
         else transform_expression env (parse_expression v) in
       (a, v'))
@@ -83,7 +83,7 @@ let prefix_or_deroute = fun prefix reroutes name attribs ->
   List.map
     (fun (a, v) ->
       let v' =
-        if String.lowercase a = name then
+        if Compat.lowercase_ascii a = name then
           try List.assoc v reroutes with
               Not_found -> prefix v
         else v in
@@ -105,7 +105,7 @@ let transform_stage = fun prefix reroutes env xml ->
   let rec tr = fun xml ->
     match xml with
         Xml.Element (tag, attribs, children) -> begin
-          match String.lowercase tag with
+          match Compat.lowercase_ascii tag with
               "exception" ->
                 transform_exception prefix reroutes env xml
             | "while" ->
@@ -276,7 +276,7 @@ let process_includes = fun dir xml ->
 
 
 let remove_attribs = fun xml names ->
-  List.filter (fun (x,_) -> not (List.mem (String.lowercase x) names)) (Xml.attribs xml)
+  List.filter (fun (x,_) -> not (List.mem (Compat.lowercase_ascii x) names)) (Xml.attribs xml)
 
 let xml_assoc_attrib = fun a v xmls ->
   List.find (fun x -> ExtXml.attrib x a = v) xmls
@@ -327,7 +327,7 @@ let replace_from = fun stage waypoints ->
 
 let process_stage = fun stage waypoints ->
   let rec do_it = fun stage ->
-    match String.lowercase (Xml.tag stage) with
+    match Compat.lowercase_ascii (Xml.tag stage) with
         "go" | "stay" | "circle" ->
           replace_from (replace_wp stage waypoints) waypoints
 

sw/lib/ocaml/gen_common.ml

@@ -160,7 +160,7 @@ let get_autopilot_of_airframe = fun ?target xml ->
  * Returns the boolean expression of targets of a module *)
 let get_targets_of_module = fun xml ->
   Xml.fold (fun a x ->
-    match Compat.bytes_lowercase (Xml.tag x) with
+    match Compat.lowercase_ascii (Xml.tag x) with
     | "makefile" when a = Var "" -> targets_of_field x Env.default_module_targets
     | "makefile" -> Or (a, targets_of_field x Env.default_module_targets)
     | _ -> a

sw/lib/ocaml/mapCanvas.ml

@@ -587,7 +587,7 @@ object (self)
           end
           | _ ->    false
       with
-          Invalid_argument "ml_lookup_from_c" -> (* Raised GdkEvent.get_type *)
+          Invalid_argument _ -> (* Raised GdkEvent.get_type *)
             false
 
 

sw/lib/ocaml/mapFP.ml

@@ -34,7 +34,7 @@ let float_attr = fun xml a -> float_of_string (ExtXml.attrib xml a)
 let rec assoc_nocase at = function
 [] -> raise Not_found
   | (a, v)::avs ->
-    if Compat.bytes_uppercase at = Compat.bytes_uppercase a then v else assoc_nocase at avs
+    if Compat.uppercase_ascii at = Compat.uppercase_ascii a then v else assoc_nocase at avs
 
 (** Returns the WGS84 coordinates of a waypoint, either from its relative x and
     y coordinates or from its lat and long *)
@@ -203,7 +203,7 @@ let display_kml = fun ?group color geomap xml ->
   try
     let document = ExtXml.child xml "Document" in
     let rec loop = fun child ->
-      let tag = Compat.bytes_lowercase (Xml.tag child) in
+      let tag = Compat.lowercase_ascii (Xml.tag child) in
       match tag with
         | "linestring" | "linearring" ->
             let coordinates = ExtXml.child child "coordinates" in
@@ -266,7 +266,7 @@ class flight_plan = fun ?format_attribs ?editable ~show_moved geomap color fp_dt
     let waypoints = ExtXml.child xml "waypoints" in
     try
       List.fold_left (fun l x ->
-        match Compat.bytes_lowercase (Xml.tag x) with
+        match Compat.lowercase_ascii (Xml.tag x) with
             "kml" ->
               let file = ExtXml.attrib x "file" in
               display_kml ~group:wpts_group#group color geomap (ExtXml.parse_file (Env.flight_plans_path // file));

sw/lib/ocaml/papget.ml

@@ -368,7 +368,7 @@ object (self)
     let (x, y) = item#xy in
     let attrs =
       [ "type", msg_obj#type_;
-        "display", Compat.bytes_lowercase item#renderer#tag;
+        "display", Compat.lowercase_ascii item#renderer#tag;
         "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
     Xml.Element ("papget", attrs, scale_prop::val_props@renderer_props)
 end
@@ -387,7 +387,7 @@ object
     let (x, y) = item#xy in
     let attrs =
       [ "type", type_;
-        "display", Compat.bytes_lowercase item#renderer#tag;
+        "display", Compat.lowercase_ascii item#renderer#tag;
         "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
     Xml.Element ("papget", attrs, properties@props)
 end
@@ -416,7 +416,7 @@ object (self)
     let (x, y) = item#xy in
     let attrs =
       [ "type", "video_plugin";
-        "display", Compat.bytes_lowercase item#renderer#tag;
+        "display", Compat.lowercase_ascii item#renderer#tag;
         "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
     Xml.Element ("papget", attrs, properties@props)
   initializer ignore(adj#connect#value_changed (fun () -> self#update_zoom (string_of_float adj#value)))

sw/lib/ocaml/srtm.ml

@@ -87,7 +87,8 @@ let area_of_tile = fun tile ->
   let area = open_compressed "srtm.data.bz2" in
   let rec _area_of_tile = fun () ->
     try
-      Scanf.fscanf area "%s %s\n" (fun t a ->
+      let ib = Scanf.Scanning.from_channel area in
+      Scanf.bscanf ib "%s %s\n" (fun t a ->
         if t = tile then a
         else _area_of_tile ())
     with

sw/lib/ocaml/xmlEdit.ml

@@ -352,21 +352,21 @@ let set_attribs = fun ((model, path):node) attribs ->
 let rec replace_assoc a v = function
 [] -> [(a, v)]
   | (a', v')::l ->
-    if a = Compat.bytes_uppercase a'
+    if a = Compat.uppercase_ascii a'
     then (a, v)::l
     else (a', v')::replace_assoc a v l
 
 let set_attrib = fun node (a, v) ->
   let atbs = attribs node in
-  set_attribs node (replace_assoc (Compat.bytes_uppercase a) v atbs)
+  set_attribs node (replace_assoc (Compat.uppercase_ascii a) v atbs)
 
 let attrib = fun node at ->
-  let at = Compat.bytes_uppercase at in
+  let at = Compat.uppercase_ascii at in
   let ats = attribs node in
   let rec loop = function
   [] -> raise Not_found
     | (a,v)::avs ->
-      if Compat.bytes_uppercase a = at then v else loop avs in
+      if Compat.uppercase_ascii a = at then v else loop avs in
   loop ats
 
 let tag = fun ((model, path):node) ->

sw/logalizer/export.ml

@@ -165,7 +165,7 @@ let export_values = fun ?(sep="tab") ?(export_geo_pos=true) (model:GTree.tree_st
 
     let lookup = fun m field  ->
       try
-	PprzLink.string_of_value (Hashtbl.find last_values (m,String.lowercase field))
+	PprzLink.string_of_value (Hashtbl.find last_values (m,Compat.lowercase_ascii field))
       with
 	Not_found -> "" in
 

sw/logalizer/plotter.ml

@@ -574,7 +574,7 @@ let _ =
     match !init with
       [] -> failwith "unreachable"
     | x::xs -> init := try ignore (float_of_string s); {x with consts = s::x.consts} :: xs with
-                       | Failure "float_of_string" -> {x with curves = s::x.curves} :: xs in
+                       | Failure _ -> {x with curves = s::x.curves} :: xs in
 
   let set_title = fun s ->
     match !init with

sw/simulator/flightModel.ml

@@ -101,7 +101,7 @@ module Make(A:Data.MISSION) = struct
 
   let float_value = fun section s ->
     let x = (defined_value section s) in
-    try float_of_string x with Failure "float_of_string" ->
+    try float_of_string x with Failure _ ->
       failwith (sprintf "float_of_string: %s" x)
 
   (* FIXME: refactor code_unit_scale of tag to pprz.ml *)

sw/supervision/pc_aircraft.ml

@@ -83,7 +83,7 @@ let parse_conf_xml = fun vbox ->
   let strings = ref [] in
   Hashtbl.iter (fun name _ac -> strings := name :: !strings) Utils.aircrafts;
   let compare_ignore_case = fun s1 s2 ->
-    String.compare (String.lowercase s1) (String.lowercase s2) in
+    String.compare (Compat.lowercase_ascii s1) (Compat.lowercase_ascii s2) in
   let ordered = List.sort compare_ignore_case ("" :: !strings) in
   Gtk_tools.combo ordered vbox
 

sw/tools/generators/gen_abi.ml

@@ -84,7 +84,7 @@ module Gen_onboard = struct
     Printf.fprintf h "\n/* Messages IDs */\n";
     List.iter (fun msg ->
       if msg.id > !highest_id then highest_id := msg.id;
-      Printf.fprintf h "#define ABI_%s_ID %d\n" (String.capitalize msg.name) msg.id
+      Printf.fprintf h "#define ABI_%s_ID %d\n" (Compat.capitalize_ascii msg.name) msg.id
     ) messages;
     !highest_id
 
@@ -109,14 +109,14 @@ module Gen_onboard = struct
   let print_callbacks = fun h messages ->
     Printf.fprintf h "\n/* Callbacks */\n";
     List.iter (fun msg ->
-      Printf.fprintf h "typedef void (*abi_callback%s)" (String.capitalize msg.name);
+      Printf.fprintf h "typedef void (*abi_callback%s)" (Compat.capitalize_ascii msg.name);
       print_args h msg.fields;
       Printf.fprintf h ";\n";
     ) messages
 
   (* Print a bind function *)
   let print_msg_bind = fun h msg ->
-    let name = String.capitalize msg.name in
+    let name = Compat.capitalize_ascii msg.name in
     Printf.fprintf h "\nstatic inline void AbiBindMsg%s(uint8_t sender_id, abi_event * ev, abi_callback%s cb) {\n" name name;
     Printf.fprintf h "  if (abi_queues[ABI_%s_ID] == ev) return;\n" name;
     Printf.fprintf h "  ev->id = sender_id;\n";
@@ -133,7 +133,7 @@ module Gen_onboard = struct
         | [(n,_)] -> Printf.fprintf h ", %s);\n" n
         | (n,_)::l' -> Printf.fprintf h ", %s" n; args h l'
     in
-    let name = String.capitalize msg.name in
+    let name = Compat.capitalize_ascii msg.name in
     Printf.fprintf h "\nstatic inline void AbiSendMsg%s" name;
     print_args h msg.fields;
     Printf.fprintf h " {\n";

sw/tools/generators/gen_aircraft.ml

@@ -58,7 +58,7 @@ let check_unique_id_and_name = fun conf conf_xml ->
 
 let configure_xml2mk = fun ?(default_configure=false) f xml ->
   (* all makefiles variables are forced to uppercase *)
-  let name = Compat.bytes_uppercase (ExtXml.attrib xml "name")
+  let name = Compat.uppercase_ascii (ExtXml.attrib xml "name")
   and value = ExtXml.attrib_or_default xml "value" ""
   and default = ExtXml.attrib_or_default xml "default" ""
   and case = ExtXml.attrib_or_default xml "case" "" in
@@ -138,7 +138,7 @@ let file_xml2mk = fun f ?(arch = false) dir_name target xml ->
 let module_configure_xml2mk = fun ?(default_configure=false) f target firmware m ->
   (* print global config flags *)
   List.iter (fun flag ->
-    match Compat.bytes_lowercase (Xml.tag flag) with
+    match Compat.lowercase_ascii (Xml.tag flag) with
     | "configure" -> configure_xml2mk ~default_configure f flag
     | _ -> ()) m.param;
   (* Look for makefile section *)
@@ -158,7 +158,7 @@ let module_configure_xml2mk = fun ?(default_configure=false) f target firmware m
       in
       Xml.iter
       (fun field ->
-          match Compat.bytes_lowercase (Xml.tag field) with
+          match Compat.lowercase_ascii (Xml.tag field) with
           | "configure" -> configure_xml2mk ~default_configure f field
           | _ -> ()
         ) section
@@ -168,11 +168,11 @@ let module_configure_xml2mk = fun ?(default_configure=false) f target firmware m
 let module_xml2mk = fun f target firmware m ->
   let name = ExtXml.attrib m.xml "name" in
   let dir = try Xml.attrib m.xml "dir" with Xml.No_attribute _ -> name in
-  let dir_name = Compat.bytes_uppercase dir ^ "_DIR" in
+  let dir_name = Compat.uppercase_ascii dir ^ "_DIR" in
   (* print global flags as compilation defines and flags *)
   fprintf f "\n# makefile for module %s in modules/%s\n" name dir;
   List.iter (fun flag ->
-    match Compat.bytes_lowercase (Xml.tag flag) with
+    match Compat.lowercase_ascii (Xml.tag flag) with
     | "define" -> define_xml2mk f ~target flag
     | _ -> ()) m.param;
   (* Look for makefile section *)
@@ -195,7 +195,7 @@ let module_xml2mk = fun f target firmware m ->
       let _ = match cond with Some c -> fprintf f "%s\n" c | None -> () in
       Xml.iter
       (fun field ->
-          match Compat.bytes_lowercase (Xml.tag field) with
+          match Compat.lowercase_ascii (Xml.tag field) with
           | "define" -> define_xml2mk f ~target field
           | "include" -> include_xml2mk f ~target ~vpath:m.vpath field
           | "flag" -> flag_xml2mk f ~target field
@@ -216,7 +216,7 @@ let modules_xml2mk = fun f target ac_id xml fp ->
   (** include modules directory for ALL targets, not just the defined ones **)
   fprintf f "$(TARGET).CFLAGS += -Imodules -Iarch/$(ARCH)/modules\n";
   List.iter
-    (fun dir -> fprintf f "%s_DIR = modules/%s\n" (Compat.bytes_uppercase dir) dir
+    (fun dir -> fprintf f "%s_DIR = modules/%s\n" (Compat.uppercase_ascii dir) dir
     ) dir_list;
   (* add vpath for external modules *)
   List.iter
@@ -250,7 +250,7 @@ let subsystem_xml2mk = fun f firmware s ->
   List.iter (fun def -> define_xml2mk f def) s_defines;
   (* include subsystem *) (* TODO test if file exists with the generator ? *)
   let s_name = name ^ s_type ^ ".makefile" in
-  let s_dir = "CFG_" ^ Compat.bytes_uppercase (Xml.attrib firmware "name") in
+  let s_dir = "CFG_" ^ Compat.uppercase_ascii (Xml.attrib firmware "name") in
   fprintf f "ifneq ($(strip $(wildcard $(%s)/%s)),)\n" s_dir s_name;
   fprintf f "\tinclude $(%s)/%s\n" s_dir s_name;
   fprintf f "else\n";

sw/tools/generators/gen_airframe.ml

@@ -156,7 +156,7 @@ let parse_element = fun prefix s ->
 
 
 let print_reverse_servo_table = fun driver servos ->
-  let d = match driver with "Default" -> "" | _ -> "_"^(String.uppercase driver) in
+  let d = match driver with "Default" -> "" | _ -> "_"^(Compat.uppercase_ascii driver) in
   printf "static inline int get_servo_min%s(int _idx) {\n" d;
   printf "  switch (_idx) {\n";
   List.iter (fun c ->
@@ -312,8 +312,8 @@ let rec parse_section = fun ac_id s ->
       let servos = Xml.children s in
       let nb_servos = List.fold_right (fun s m -> Pervasives.max (int_of_string (ExtXml.attrib s "no")) m) servos min_int + 1 in
 
-      define (sprintf "SERVOS_%s_NB" (Compat.bytes_uppercase driver)) (string_of_int nb_servos);
-      printf "#include \"subsystems/actuators/actuators_%s.h\"\n" (Compat.bytes_lowercase driver);
+      define (sprintf "SERVOS_%s_NB" (Compat.uppercase_ascii driver)) (string_of_int nb_servos);
+      printf "#include \"subsystems/actuators/actuators_%s.h\"\n" (Compat.lowercase_ascii driver);
       nl ();
       List.iter (parse_servo driver) servos;
       print_reverse_servo_table driver servos;

sw/tools/generators/gen_autopilot.ml

@@ -93,7 +93,7 @@ let print_includes = fun includes out_h ->
   ) (Xml.children includes)
 
 let print_mode_name = fun sm_name name ->
-  String.concat "" [(String.uppercase sm_name); "_MODE_"; (String.uppercase name)]
+  String.concat "" [(Compat.uppercase_ascii sm_name); "_MODE_"; (Compat.uppercase_ascii name)]
 
 (** Define modes *)
 let print_modes = fun modes sm_name out_h ->
@@ -340,7 +340,7 @@ let parse_and_gen_modes xml_file ap_name main_freq h_dir sm =
   try
     (* Get state machine name *)
     let name = Xml.attrib sm "name" in
-    let name_up = String.uppercase name in
+    let name_up = Compat.uppercase_ascii name in
     (* Generate start of header *)
     begin_out xml_file ("AUTOPILOT_CORE_"^name_up^"_H") out_h;
     fprintf out_h "/*** %s ***/\n\n" ap_name;
@@ -394,7 +394,7 @@ let write_settings = fun xml_file out_set ap ->
   fprintf out_set "  <dl_settings>\n";
   (* Filter state machines that need to be displayed *)
   let sm_filtered = List.filter (fun sm ->
-    try (String.lowercase (Xml.attrib sm "settings_mode")) = "true" with _ -> false
+    try (Compat.lowercase_ascii (Xml.attrib sm "settings_mode")) = "true" with _ -> false
     ) (Xml.children ap) in
   if List.length sm_filtered > 0 then begin
     (* Create node if there is at least one to display *)
@@ -404,7 +404,7 @@ let write_settings = fun xml_file out_set ap ->
       let name = Xml.attrib sm "name" in
       (* Iter on modes and store min, max and values *)
       let (_, min, max, values) = List.fold_left (fun (current, min, max, values) m ->
-        let print = try String.lowercase (Xml.attrib m "settings") <> "hide" with _ -> true in
+        let print = try Compat.lowercase_ascii (Xml.attrib m "settings") <> "hide" with _ -> true in
         let name = Xml.attrib m "name" in
         if print then begin
           let min = match min with

sw/tools/generators/gen_flight_plan.ml

@@ -82,7 +82,7 @@ let float_attrib = fun xml a ->
   try
     float_of_string (Xml.attrib xml a)
   with
-      Failure "float_of_string" ->
+      Failure _ ->
         failwith (sprintf "Float expected in attribute '%s' from %s" a (Xml.to_string_fmt xml))
 let name_of = fun wp -> ExtXml.attrib wp "name"
 
@@ -205,7 +205,7 @@ let pprz_throttle = fun s ->
       if g < 0. || g > 1. then
         failwith "throttle must be > 0 and < 1"
     with
-        Failure "float_of_string" -> () (* No possible check on expression *)
+        Failure _ -> () (* No possible check on expression *)
   end;
   sprintf "9600*(%s)" s
 
@@ -213,7 +213,7 @@ let pprz_throttle = fun s ->
 (********************* Vertical control ********************************************)
 let output_vmode = fun stage_xml wp last_wp ->
   let pitch = try Xml.attrib stage_xml "pitch" with _ -> "0.0" in
-  if String.lowercase (Xml.tag stage_xml) <> "manual"
+  if Compat.lowercase_ascii (Xml.tag stage_xml) <> "manual"
   then begin
     if pitch = "auto"
     then begin
@@ -237,7 +237,7 @@ let output_vmode = fun stage_xml wp last_wp ->
                 check_altitude (float_of_string a) stage_xml
               with
         (* Impossible to check the altitude on an expression: *)
-                  Failure "float_of_string" -> ()
+                  Failure _ -> ()
             end;
             a
           with _ ->
@@ -248,7 +248,7 @@ let output_vmode = fun stage_xml wp last_wp ->
                   check_altitude ((float_of_string h) +. !ground_alt) stage_xml
                 with
           (* Impossible to check the altitude on an expression: *)
-                    Failure "float_of_string" -> ()
+                    Failure _ -> ()
               end;
               sprintf "Height(%s)" h
             with _ ->
@@ -316,7 +316,7 @@ let rec index_stage = fun x ->
   end
 
 
-let inside_function = fun name -> "Inside" ^ String.capitalize name
+let inside_function = fun name -> "Inside" ^ Compat.capitalize_ascii name
 
 (* pre call utility function *)
 let fp_pre_call = fun x ->
@@ -342,7 +342,7 @@ let stage_until = fun x ->
 let rec print_stage = fun index_of_waypoints x ->
   let stage () = incr stage;lprintf "Stage(%d)\n" !stage; right () in
   begin
-    match String.lowercase (Xml.tag x) with
+    match Compat.lowercase_ascii (Xml.tag x) with
       | "return" ->
         stage ();
         lprintf "Return(%s);\n" (ExtXml.attrib_or_default x "reset_stage" "0");
@@ -547,9 +547,9 @@ let rec print_stage = fun index_of_waypoints x ->
         let statement = ExtXml.attrib  x "fun" in
         (* by default, function is called while returning TRUE *)
         (* otherwise, function is called once and returned value is ignored *)
-        let loop = String.uppercase (ExtXml.attrib_or_default x "loop" "TRUE") in
+        let loop = Compat.uppercase_ascii (ExtXml.attrib_or_default x "loop" "TRUE") in
         (* be default, go to next stage immediately *)
-        let break = String.uppercase (ExtXml.attrib_or_default x "break" "FALSE") in
+        let break = Compat.uppercase_ascii (ExtXml.attrib_or_default x "break" "FALSE") in
         begin match loop with
         | "TRUE" ->
             lprintf "if (! (%s)) {\n" statement;
@@ -582,7 +582,7 @@ let rec print_stage = fun index_of_waypoints x ->
         stage ();
         let statement = ExtXml.attrib  x "fun" in
         (* by default, go to next stage immediately *)
-        let break = String.uppercase (ExtXml.attrib_or_default x "break" "FALSE") in
+        let break = Compat.uppercase_ascii (ExtXml.attrib_or_default x "break" "FALSE") in
         lprintf "%s;\n" statement;
         begin match break with
         | "TRUE" -> lprintf "NextStageAndBreak();\n";
@@ -1144,7 +1144,7 @@ let () =
         List.map (fun w -> incr i; (name_of w, !i)) waypoints in
 
       let sectors_element = try ExtXml.child xml "sectors" with Not_found -> Xml.Element ("", [], []) in
-      let sectors = List.filter (fun x -> String.lowercase (Xml.tag x) = "sector") (Xml.children sectors_element) in
+      let sectors = List.filter (fun x -> Compat.lowercase_ascii (Xml.tag x) = "sector") (Xml.children sectors_element) in
       let sectors_type = List.map (fun x -> match ExtXml.attrib_or_default x "type" "static" with "dynamic" -> DynamicSector | _ -> StaticSector) sectors in
       let sectors = List.map (parse_wpt_sector index_of_waypoints waypoints) sectors in
       List.iter2 print_inside_sector sectors_type sectors;

sw/tools/generators/gen_modules.ml

@@ -80,7 +80,7 @@ let get_cap_name = fun f ->
   match name with
     | [Str.Text t]
     | [Str.Text t; Str.Delim "("; Str.Delim ")"]
-    | [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> String.uppercase t
+    | [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> Compat.uppercase_ascii t
     | _ -> failwith "Gen_modules: not a valid function name"
 
 let print_function_freq = fun modules ->

sw/tools/generators/gen_periodic.ml

@@ -140,7 +140,7 @@ let print_message_table = fun out_h xml ->
   let telemetry_types = Hashtbl.create 2 in
   (* For each process *)
   List.iter (fun process ->
-    let telem_type = String.uppercase (ExtXml.attrib_or_default process "type" "pprz") in
+    let telem_type = Compat.uppercase_ascii (ExtXml.attrib_or_default process "type" "pprz") in
     if not (Hashtbl.mem telemetry_types telem_type) then Hashtbl.add telemetry_types telem_type (Hashtbl.create 15);
     let messages = Hashtbl.find telemetry_types telem_type in
     (** For each mode of this process *)
@@ -176,7 +176,7 @@ let print_process_send = fun out_h xml freq ->
   List.iter
     (fun process ->
       let process_name = ExtXml.attrib process "name" in
-      let telem_type = String.uppercase (ExtXml.attrib_or_default process "type" "pprz") in
+      let telem_type = Compat.uppercase_ascii (ExtXml.attrib_or_default process "type" "pprz") in
       let modes = Xml.children process in
 
       fprintf out_h "\n/* Periodic telemetry (type %s): %s process */\n" telem_type process_name;
@@ -199,14 +199,14 @@ let print_process_send = fun out_h xml freq ->
       ) 0 modes in
 
       fprintf out_h "\n/* Functions for %s process */\n" process_name;
-      fprintf out_h "#ifdef PERIODIC_C_%s\n" (String.uppercase process_name);
-      fprintf out_h "#ifndef TELEMETRY_MODE_%s\n" (String.uppercase process_name);
-      fprintf out_h "#define TELEMETRY_MODE_%s 0\n" (String.uppercase process_name);
+      fprintf out_h "#ifdef PERIODIC_C_%s\n" (Compat.uppercase_ascii process_name);
+      fprintf out_h "#ifndef TELEMETRY_MODE_%s\n" (Compat.uppercase_ascii process_name);
+      fprintf out_h "#define TELEMETRY_MODE_%s 0\n" (Compat.uppercase_ascii process_name);
       fprintf out_h "#endif\n";
-      fprintf out_h "uint8_t telemetry_mode_%s = TELEMETRY_MODE_%s;\n" process_name (String.uppercase process_name);
-      fprintf out_h "#else /* PERIODIC_C_%s not defined (general header) */\n" (String.uppercase process_name);
+      fprintf out_h "uint8_t telemetry_mode_%s = TELEMETRY_MODE_%s;\n" process_name (Compat.uppercase_ascii process_name);
+      fprintf out_h "#else /* PERIODIC_C_%s not defined (general header) */\n" (Compat.uppercase_ascii process_name);
       fprintf out_h "extern uint8_t telemetry_mode_%s;\n" process_name;
-      fprintf out_h "#endif /* PERIODIC_C_%s */\n" (String.uppercase process_name);
+      fprintf out_h "#endif /* PERIODIC_C_%s */\n" (Compat.uppercase_ascii process_name);
 
       lprintf out_h "static inline void periodic_telemetry_send_%s(struct periodic_telemetry *telemetry, struct transport_tx *trans, struct link_device *dev) {  /* %dHz */\n" process_name freq;
       right ();

sw/tools/generators/gen_settings.ml

@@ -239,7 +239,7 @@ let calib_mode_of_rc = function
   | "gain_2_down" -> 2, "down"
   | x -> failwith (sprintf "Unknown rc: %s" x)
 
-let param_macro_of_type = fun x -> "ParamVal"^String.capitalize x
+let param_macro_of_type = fun x -> "ParamVal"^Compat.capitalize_ascii x
 
 let parse_rc_setting = fun xml ->
   let cursor, cm = calib_mode_of_rc (ExtXml.attrib xml "rc")
@@ -253,7 +253,7 @@ let parse_rc_setting = fun xml ->
   let var_nostruct = String.sub var dot_pos (String.length var - dot_pos) in
   let var_init = var_nostruct ^ "_init" in
 
-  lprintf "if (rc_settings_mode == RC_SETTINGS_MODE_%s) { \\\n" (String.uppercase cm);
+  lprintf "if (rc_settings_mode == RC_SETTINGS_MODE_%s) { \\\n" (Compat.uppercase_ascii cm);
   right ();
   lprintf "static %s %s; \\\n" (inttype t) var_init;
   lprintf "static int16_t slider%d_init; \\\n" cursor;

sw/tools/generators/gen_ubx.ml

@@ -112,7 +112,7 @@ let parse_message = fun class_name m ->
 
   (** Generating send function *)
   let param_type = fun f -> c_type (format f) in
-  let param_name = fun f ->String.lowercase (field_name f) in
+  let param_name = fun f ->Compat.lowercase_ascii (field_name f) in
   let param_name_and_type = fun f ->
     sprintf "%s ubx_%s" (param_type f) (param_name f) in
   let rec param_names = fun f r ->

sw/tools/generators/gen_xsens.ml

@@ -111,7 +111,7 @@ let parse_message = fun m ->
 
   (** Generating send function *)
   let gen_send_macro = fun _ ->
-    let param_name = fun f -> String.lowercase (field_name f) in
+    let param_name = fun f -> Compat.lowercase_ascii (field_name f) in
     let rec param_names = fun f r ->
       if Xml.tag f = "field" then
         param_name f :: r