From 01ab2ccb33e11e63e4d2a564b4ee08f0593d71c5 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Thu, 5 Feb 2009 16:27:47 +0100
Subject: [PATCH] Fix a bug in the -esa mode: all program using constants were
crashing.
---
src/structArrayExpand.ml | 67 +++++++++++++---------------------------
src/test/Makefile | 2 +-
2 files changed, 22 insertions(+), 47 deletions(-)
diff --git a/src/structArrayExpand.ml b/src/structArrayExpand.ml
index 22cc2b53..1691d764 100644
--- a/src/structArrayExpand.ml
+++ b/src/structArrayExpand.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 03/02/2009 (at 11:14) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/02/2009 (at 16:24) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be recursive, it migth be a lot of new variables...
@@ -289,25 +289,26 @@ and (var_trees_of_val_exp : Eff.local_env -> Eff.id_solver -> acc -> Eff.val_exp
acc, A l
| _, (S _ | L _) -> assert false
)
- | IDENT idref ->
- let vi =
- try id_solver.id2var idref lxm
- with _ ->
- raise (Errors.Compile_error(
- lxm,
- ("\n*** '"^(Ident.string_of_idref idref)^
- "': Unknown variable.\n*** Current variables are: " ^
- (Hashtbl.fold
- (fun id vi_eff acc ->
- acc ^ (Format.sprintf
- "\n\t%s" (LicDump.string_of_var_info_eff4msg vi_eff))
- )
- nenv.lenv_vars
- ""
- ))))
- in
- acc, gen_var_trees (make_val_exp nenv lxm vi) "" vi.var_type_eff
-
+ | IDENT idref -> (
+ try
+ let vi = id_solver.id2var idref lxm in
+ (acc,
+ gen_var_trees (make_val_exp nenv lxm vi) "" vi.var_type_eff)
+ with _ ->
+ try let _const = id_solver.id2const idref lxm in
+ (acc, L ve)
+ with _ ->
+ let msg =
+ "\n*** during Array expansion: '"^
+ (Ident.string_of_idref idref)^
+ "': Unknown variable.\n*** Current variables are: " ^
+ (Hashtbl.fold
+ (fun id vi_eff acc -> acc ^ (Format.sprintf "\n\t%s"
+ (LicDump.string_of_var_info_eff4msg vi_eff)))
+ nenv.lenv_vars "")
+ in
+ raise (Errors.Compile_error(lxm, msg))
+ )
| WITH(_) | HAT(_) | CONCAT | ARRAY(_)
| Predef _ | CALL _ | MERGE _ | CONST _
| PRE | ARROW | FBY | CURRENT | WHEN _ | TUPLE
@@ -455,35 +456,9 @@ let (node : Eff.id_solver -> Eff.local_env -> Eff.node_exp -> Eff.node_exp) =
let inlist = n.inlist_eff in
let outlist = n.outlist_eff in
let acc = ([],[],[]) in
-(* let _ = *)
-(* print_string *)
-(* ("\n*** nenv.lenv_vars (avant) = " ^ *)
-(* (Hashtbl.fold *)
-(* (fun id vi_eff acc -> *)
-(* acc ^ (Format.sprintf *)
-(* "\n\t%s" (LicDump.string_of_var_info_eff4msg vi_eff)) *)
-(* ) *)
-(* n_env.lenv_vars *)
-(* "" *)
-(* )); *)
-(* flush stdout *)
-(* in *)
let inlist, acc = List.fold_left (expand_var_info n_env is) ([],acc) inlist in
let outlist, acc = List.fold_left (expand_var_info n_env is) ([],acc) outlist in
let loclist, acc = List.fold_left (expand_var_info n_env is) ([],acc) loclist in
-
-(* let _ = *)
-(* print_string ("\n*** nenv.lenv_vars (avant) = "^ *)
-(* (Hashtbl.fold *)
-(* (fun id vi_eff acc -> *)
-(* acc ^ (Format.sprintf *)
-(* "\n\t%s" (LicDump.string_of_var_info_eff4msg vi_eff)) *)
-(* ) *)
-(* n_env.lenv_vars *)
-(* "" *)
-(* )); *)
-(* flush stdout *)
-(* in *)
let acc = List.fold_left (expand_eq n_env is) acc b.eqs_eff in
let acc = List.fold_left (expand_assert n_env is) acc b.asserts_eff in
let (asserts,neqs, nv) = acc in
diff --git a/src/test/Makefile b/src/test/Makefile
index a03915f9..6faa554a 100644
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -96,7 +96,7 @@ test_ec:
echo -e "\n$(NL)====> $(LC) -ec $$d -o /tmp/xx.ec" >> test_ec.res; \
$(LC0) -ec $$d -o /tmp/xx.ec >> test_ec.res 2>&1 ;\
echo -e "ec2c /tmp/xx.ec" >> test_ec.res; \
- ec2c /tmp/xx.ec >> test_ec.res 2>&1 ;\
+ (ec2c /tmp/xx.ec >> test_ec.res 2>&1 && echo -n "ok ") || echo " KO!";\
done; \
diff -u test_ec.res.exp test_ec.res > test_ec.diff || \
(cat test.diff ; echo "cf test.diff"; exit 1)
--
GitLab