From d4709f77750c991f7004cbcaaa73795121861bb0 Mon Sep 17 00:00:00 2001 From: Rijesh Augustine Date: Fri, 26 Jan 2018 14:08:06 -0700 Subject: [PATCH] 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/ext/pprzlink | 2 +- sw/ground_segment/cockpit/gcs.ml | 8 ++++---- sw/ground_segment/cockpit/live.ml | 2 +- sw/ground_segment/cockpit/page_settings.ml | 6 +++--- sw/ground_segment/cockpit/saveSettings.ml | 2 +- sw/ground_segment/cockpit/sectors.ml | 2 +- sw/ground_segment/tmtc/messages.ml | 2 +- sw/ground_segment/tmtc/server_globals.ml | 2 +- sw/lib/ocaml/Makefile | 3 +++ sw/lib/ocaml/compat.ml | 22 ++++++++++++++++------ sw/lib/ocaml/compat.mli | 6 ++++-- sw/lib/ocaml/expr_lexer.mll | 2 +- sw/lib/ocaml/extXml.ml | 8 ++++---- sw/lib/ocaml/fp_proc.ml | 12 ++++++------ sw/lib/ocaml/gen_common.ml | 2 +- sw/lib/ocaml/mapCanvas.ml | 2 +- sw/lib/ocaml/mapFP.ml | 6 +++--- sw/lib/ocaml/papget.ml | 6 +++--- sw/lib/ocaml/srtm.ml | 3 ++- sw/lib/ocaml/xmlEdit.ml | 8 ++++---- sw/logalizer/export.ml | 2 +- sw/logalizer/plotter.ml | 2 +- sw/simulator/flightModel.ml | 2 +- sw/supervision/pc_aircraft.ml | 2 +- sw/tools/generators/gen_abi.ml | 8 ++++---- sw/tools/generators/gen_aircraft.ml | 16 ++++++++-------- sw/tools/generators/gen_airframe.ml | 6 +++--- sw/tools/generators/gen_autopilot.ml | 8 ++++---- sw/tools/generators/gen_flight_plan.ml | 22 +++++++++++----------- sw/tools/generators/gen_modules.ml | 2 +- sw/tools/generators/gen_periodic.ml | 16 ++++++++-------- sw/tools/generators/gen_settings.ml | 4 ++-- sw/tools/generators/gen_ubx.ml | 2 +- sw/tools/generators/gen_xsens.ml | 2 +- 34 files changed, 108 insertions(+), 92 deletions(-) diff --git a/sw/ext/pprzlink b/sw/ext/pprzlink index e4a4bf3d5c..25b7024ad4 160000 --- a/sw/ext/pprzlink +++ b/sw/ext/pprzlink @@ -1 +1 @@ -Subproject commit e4a4bf3d5c10d848d541a963e9ac103e17541ca1 +Subproject commit 25b7024ad46964b4c99c998b75eca6db34ceab5b diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 7aa23404bd..f2c3f8d826 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/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 diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index 93fd1f4e50..9a9db51617 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/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 diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml index 7601e9c384..7b31cc5bee 100644 --- a/sw/ground_segment/cockpit/page_settings.ml +++ b/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 *) diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index f0a8c6870a..583a983d2e 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/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 *) diff --git a/sw/ground_segment/cockpit/sectors.ml b/sw/ground_segment/cockpit/sectors.ml index d1b032880e..5e2b12a286 100644 --- a/sw/ground_segment/cockpit/sectors.ml +++ b/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 diff --git a/sw/ground_segment/tmtc/messages.ml b/sw/ground_segment/tmtc/messages.ml index 6a0cbdec8c..8e6ecfa0f8 100644 --- a/sw/ground_segment/tmtc/messages.ml +++ b/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 diff --git a/sw/ground_segment/tmtc/server_globals.ml b/sw/ground_segment/tmtc/server_globals.ml index 2b23c1b106..b34ddb8b8b 100644 --- a/sw/ground_segment/tmtc/server_globals.ml +++ b/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 diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index b3f1a33c48..174c3bcff7 100644 --- a/sw/lib/ocaml/Makefile +++ b/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)" diff --git a/sw/lib/ocaml/compat.ml b/sw/lib/ocaml/compat.ml index 0d888af199..1292567e0d 100644 --- a/sw/lib/ocaml/compat.ml +++ b/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 diff --git a/sw/lib/ocaml/compat.mli b/sw/lib/ocaml/compat.mli index df0f3ebdc2..808a44dd51 100644 --- a/sw/lib/ocaml/compat.mli +++ b/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 diff --git a/sw/lib/ocaml/expr_lexer.mll b/sw/lib/ocaml/expr_lexer.mll index a058314247..56b0d32ef7 100644 --- a/sw/lib/ocaml/expr_lexer.mll +++ b/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 diff --git a/sw/lib/ocaml/extXml.ml b/sw/lib/ocaml/extXml.ml index 25f7bb05e3..0fe134425d 100644 --- a/sw/lib/ocaml/extXml.ml +++ b/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) -> diff --git a/sw/lib/ocaml/fp_proc.ml b/sw/lib/ocaml/fp_proc.ml index 5d82b68099..40572cea73 100644 --- a/sw/lib/ocaml/fp_proc.ml +++ b/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 diff --git a/sw/lib/ocaml/gen_common.ml b/sw/lib/ocaml/gen_common.ml index d5fec3cda3..1c6bd68872 100644 --- a/sw/lib/ocaml/gen_common.ml +++ b/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 diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index cb3cf0eee5..20479347e6 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/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 diff --git a/sw/lib/ocaml/mapFP.ml b/sw/lib/ocaml/mapFP.ml index 9d68f392a6..15f35fe742 100644 --- a/sw/lib/ocaml/mapFP.ml +++ b/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)); diff --git a/sw/lib/ocaml/papget.ml b/sw/lib/ocaml/papget.ml index b69da8032d..317e7ada08 100644 --- a/sw/lib/ocaml/papget.ml +++ b/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))) diff --git a/sw/lib/ocaml/srtm.ml b/sw/lib/ocaml/srtm.ml index 7a19b3d545..6da039ae5c 100644 --- a/sw/lib/ocaml/srtm.ml +++ b/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 diff --git a/sw/lib/ocaml/xmlEdit.ml b/sw/lib/ocaml/xmlEdit.ml index 9a2f468a02..5794416466 100644 --- a/sw/lib/ocaml/xmlEdit.ml +++ b/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) -> diff --git a/sw/logalizer/export.ml b/sw/logalizer/export.ml index 42e87ec97e..d818bff798 100644 --- a/sw/logalizer/export.ml +++ b/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 diff --git a/sw/logalizer/plotter.ml b/sw/logalizer/plotter.ml index 13dad9ef75..2e33bfd791 100644 --- a/sw/logalizer/plotter.ml +++ b/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 diff --git a/sw/simulator/flightModel.ml b/sw/simulator/flightModel.ml index 9c03da79f5..f658e16ce3 100644 --- a/sw/simulator/flightModel.ml +++ b/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 *) diff --git a/sw/supervision/pc_aircraft.ml b/sw/supervision/pc_aircraft.ml index 2135c48448..dae685b9d9 100644 --- a/sw/supervision/pc_aircraft.ml +++ b/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 diff --git a/sw/tools/generators/gen_abi.ml b/sw/tools/generators/gen_abi.ml index 59a56ab686..127748669f 100644 --- a/sw/tools/generators/gen_abi.ml +++ b/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"; diff --git a/sw/tools/generators/gen_aircraft.ml b/sw/tools/generators/gen_aircraft.ml index e2afd316ca..cf8625f10e 100644 --- a/sw/tools/generators/gen_aircraft.ml +++ b/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"; diff --git a/sw/tools/generators/gen_airframe.ml b/sw/tools/generators/gen_airframe.ml index 5425f57144..1a344af611 100644 --- a/sw/tools/generators/gen_airframe.ml +++ b/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; diff --git a/sw/tools/generators/gen_autopilot.ml b/sw/tools/generators/gen_autopilot.ml index 1be7133f6c..4cd68a27f9 100644 --- a/sw/tools/generators/gen_autopilot.ml +++ b/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 " \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 diff --git a/sw/tools/generators/gen_flight_plan.ml b/sw/tools/generators/gen_flight_plan.ml index 8546ffdee0..d5d931f5f3 100644 --- a/sw/tools/generators/gen_flight_plan.ml +++ b/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; diff --git a/sw/tools/generators/gen_modules.ml b/sw/tools/generators/gen_modules.ml index 3426b1a978..7906b25afa 100644 --- a/sw/tools/generators/gen_modules.ml +++ b/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 -> diff --git a/sw/tools/generators/gen_periodic.ml b/sw/tools/generators/gen_periodic.ml index 8069ad71a6..311f81aa3c 100644 --- a/sw/tools/generators/gen_periodic.ml +++ b/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 (); diff --git a/sw/tools/generators/gen_settings.ml b/sw/tools/generators/gen_settings.ml index 2e47ce2d21..4cd56214c2 100644 --- a/sw/tools/generators/gen_settings.ml +++ b/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; diff --git a/sw/tools/generators/gen_ubx.ml b/sw/tools/generators/gen_ubx.ml index 9a7a65d4d9..da684e8664 100644 --- a/sw/tools/generators/gen_ubx.ml +++ b/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 -> diff --git a/sw/tools/generators/gen_xsens.ml b/sw/tools/generators/gen_xsens.ml index fbaad0514d..81bd38af50 100644 --- a/sw/tools/generators/gen_xsens.ml +++ b/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