Bug correction: support of enumerated types as input for simulation

- use of a buffer to translate enumerated types from string to enum value
- hepts : correct interface with main
This commit is contained in:
Gwenaël Delaval 2015-02-27 15:39:39 +01:00
parent 95aa03ed21
commit 0d1aef8c78
3 changed files with 20 additions and 12 deletions

View file

@ -145,12 +145,11 @@ class enum_input mod_name value_list (table:GPack.table) n : input =
let _ = List.iter
(fun (v,b) ->
let prefixed_value = mod_name ^ "_" ^ v in
let click () =
if not !click_processed then
begin
click_processed := true;
value := prefixed_value;
value := v;
!active_button#set_active false;
b#set_active true;
active_button := b;
@ -260,13 +259,13 @@ let create_input v_name v_ty n (table:GPack.table) =
match v_ty with
| Tid{ qual = Pervasives; name = "int" } ->
new scale_input
0.0 0. 120.float_of_string
0. (-60.) 60. float_of_string
(fun v ->
string_of_int (int_of_float v))
0
table n
| Tid{ qual = Pervasives; name = "float" } ->
new scale_input 0. 0. 100. float_of_string string_of_float 1 table n
new scale_input 0. (-100.) 100. float_of_string string_of_float 1 table n
| Tid{ qual = Pervasives; name = "bool" } ->
new boolean_input table n
| Tid(name) ->

View file

@ -380,3 +380,12 @@ let rec array_base_ctype ty idx_list =
| Cty_arr (_, ty), _::idx_list -> array_base_ctype ty idx_list
| _ ->
assert false
(** Convert C expression to left-hand side *)
let rec clhs_of_cexpr cexpr =
match cexpr with
| Cvar v -> CLvar v
| Cderef e -> CLderef (clhs_of_cexpr e)
| Cfield (e,qn) -> CLfield (clhs_of_cexpr e, qn)
| Carray (e1,e2) -> CLarray (clhs_of_cexpr e1, e2)
| _ -> failwith("C expression not translatable to LHS")

View file

@ -162,12 +162,10 @@ let main_def_of_class_def cd =
(vn ^ "." ^ (shortname fn), args)
| _ -> assert false in
let (prompt, args_format_s) = mk_prompt lhs in
let scan_exp =
let scan_exp e =
let printf_s = Format.sprintf "%s ? " prompt in
let format_s = format_for_type ty in
let exp_scanf = Cfun_call ("scanf",
[Cconst (Cstrlit format_s);
Caddrof lhs]) in
let exp_scanf = Cfun_call ("scanf", [Cconst (Cstrlit format_s); e]) in
let body =
if !Compiler_options.hepts_simulation
then (* hepts: systematically test and quit when EOF *)
@ -186,12 +184,14 @@ let main_def_of_class_def cd =
Csblock { var_decls = [];
block_body = body; } in
match need_buf_for_ty ty with
| None -> ([scan_exp], [])
| None -> ([scan_exp (Caddrof lhs)], [])
| Some tyn ->
let varn = fresh "buf" in
([scan_exp;
Csexpr (Cfun_call (tyn ^ "_of_string",
[Cvar varn]))],
let lhs = clhs_of_cexpr lhs in
([scan_exp (Cvar varn);
Caffect (lhs,
(Cfun_call (tyn ^ "_of_string",
[Cvar varn])))],
[(varn, Cty_arr (20, Cty_char))])
end
| Tprod _ | Tinvalid -> failwith("read_lhs_of_ty: untranslatable type")