Mirrors_Framework/paparazzi
1
0
Fork 0
mirror of https://github.com/paparazzi/paparazzi.git synced 2026-06-01 21:07:40 +08:00
Code Issues Actions 25 Packages Projects Releases Wiki Activity

[ocaml] completely disable format strings for now

Browse Source 
as it causes crashes/segfaults in GCS, server and messages with OCaml 4.02
This commit is contained in:
Felix Ruess
2015-03-16 14:12:33 +01:00
parent a157808cbe
commit e80f099e80
1 changed files with 12 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
sw/lib/ocaml/pprz.ml
+12 -7
View File
@@ -172,12 +172,15 @@ let rec string_of_value = function
let magic = fun x -> (Obj.magic x:('a,'b,'c) Pervasives.format) let magic = fun x -> (Obj.magic x:('a,'b,'c) Pervasives.format)
(* FIXME temporary solution, the complete formatted_string_of_value function (* FIXME temporary solution, the complete formatted_string_of_value function
causes a segfault in server and GCS *) causes a segfault in server and GCS
magic format also cases segfaults with OCaml 4.02, so complety disable this for now
*)
let string_of_value_format = fun format v -> let string_of_value_format = fun format v ->
match v with match v with
Float x -> sprintf (magic format) x (*Float x -> sprintf (magic format) x*)
| v -> string_of_value v | v -> string_of_value v
(* FIXME: causes a segfault in server and GCS. *)
let rec formatted_string_of_value = fun format v -> let rec formatted_string_of_value = fun format v ->
match v with match v with
| Int x -> sprintf (magic format) x | Int x -> sprintf (magic format) x
@@ -733,6 +736,8 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
try List.assoc field_name values with try List.assoc field_name values with
Not_found -> Not_found ->
default_value field._type in default_value field._type in
(* should actually use this here, but it segfaults, so disable format strings for now
formatted_string_of_value field.fformat v)*)
string_of_value_format field.fformat v) string_of_value_format field.fformat v)
msg.fields) msg.fields)
@@ -753,17 +758,17 @@ module MessagesOfXml(Class:CLASS_Xml) = struct
| Some the_link_id -> begin | Some the_link_id -> begin
let index = ref 0 in let index = ref 0 in
let modified_msg = String.copy msg in let modified_msg = String.copy msg in
let func = fun c -> let func = fun c ->
match c with match c with
' ' -> begin ' ' -> begin
String.set modified_msg !index ';'; String.set modified_msg !index ';';
index := !index + 1 index := !index + 1
end end
| x -> index := !index + 1; in | x -> index := !index + 1; in
String.iter func modified_msg; String.iter func modified_msg;
Ivy.send ( Printf.sprintf "redlink TELEMETRY_MESSAGE %s %i %s" sender the_link_id modified_msg); Ivy.send ( Printf.sprintf "redlink TELEMETRY_MESSAGE %s %i %s" sender the_link_id modified_msg);
end end
let message_bind = fun ?sender ?(timestamp=false) msg_name cb -> let message_bind = fun ?sender ?(timestamp=false) msg_name cb ->
let tsregexp, tsoffset = if timestamp then "([0-9]+\\.[0-9]+ )?", 1 else "", 0 in let tsregexp, tsoffset = if timestamp then "([0-9]+\\.[0-9]+ )?", 1 else "", 0 in
match sender with match sender with