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:
parent
95aa03ed21
commit
0d1aef8c78
3 changed files with 20 additions and 12 deletions
|
@ -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) ->
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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")
|
||||
|
|
Loading…
Reference in a new issue