diff --git a/moretests/Makefile b/moretests/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..3bb12357d44b66bbc6000dd4a353c905456d2088
--- /dev/null
+++ b/moretests/Makefile
@@ -0,0 +1,135 @@
+
+OBJDIR=../obj$(HOSTTYPE)
+
+LC0=$(OBJDIR)/lus2lic
+LC=$(OBJDIR)/lus2lic -vl 2
+LC2=$(OBJDIR)/lus2lic
+
+NL="----------------------------------------------------------------------\\n"
+filter_line=grep -v Opening\ file
+
+OK_LUS=$(shell find should_work -name "*.lus" -print | LC_ALL=C sort -n)
+
+KO_LUS=$(shell find should_fail -name "*.lus" -print | LC_ALL=C sort -n)
+
+ALL_LUS=$(OK_LUS) $(KO_LUS)
+
+LIC=$(shell find should_work -name "*.lic" -print | LC_ALL=C sort -n)
+
+
+when:
+ for d in ${ALL_LUS}; do \
+ ls $$d; \
+ grep -n " when" $$d; \
+ done
+tgz:
+ tar cvfz lustre_non_reg_files.tgz should_work should_fail
+
+
+lic:
+ /bin/echo "generate all possible lic files"
+ for d in ${OK_LUS}; do \
+ /bin/echo -e "\n$(NL)====> $(LC2) $$d -o $$d.lic " ;\
+ $(LC2) $$d -o $$d.lic ;\
+ done
+
+xxx:
+ /bin/echo "reentrant ?"
+ for d in ${LIC}; do \
+ /bin/echo -e "\n$(NL)====> $(LC2) $$d " ;\
+ $(LC2) $$d > /dev/null ;\
+ done
+
+
+begin:
+ /bin/echo "Non-regression tests" > test_ok.res
+ /bin/echo "Those tests are supposed to generate errors" > test_ko.res
+
+
+unit:
+ $(LC0) -unit >> test_ok.res 2>&1
+
+help:
+ $(LC0) -help >> test_ok.res 2>&1
+
+version:
+ $(LC0) --version
+
+FILTER= grep -v "file was generated by" | grep -v " on " | grep -v "Opening file "
+
+do_not_exist:
+ $(LC) do_not_exist.lus | $(FILTER) >> test_ko.res 2>&1 || true
+
+test_lic: begin unit help version do_not_exist
+ for d in ${OK_LUS}; do \
+ /bin/echo -e "\n$(NL)====> $(LC) --nonreg-test $$d" >> test_ok.res; \
+ $(LC) --nonreg-test $$d >> test_ok.res 2>&1 ;\
+ done; \
+ for d in ${KO_LUS}; do \
+ /bin/echo -e "\n$(NL)====> $(LC) --nonreg-test $$d" >> test_ko.res; \
+ $(LC) --nonreg-test $$d >> test_ko.res 2>&1 ;\
+ done; \
+ rm -f test.res ; cat test_ok.res test_ko.res | $(FILTER) > test.res ;\
+ diff -u test.res.exp test.res > test.diff || \
+ (cat test.diff ; /bin/echo "cf test.diff"; exit 1)
+utest_lic:
+ cp test.res test.res.exp
+
+
+errors_nb:
+ /bin/echo -e "There were $(shell grep Error test_ok.res | wc -l) errors."
+ /bin/echo -e "There were $(shell grep Warning test_ok.res | wc -l) Warnings."
+
+errors:errors_nb
+ /bin/echo -e "There were $(shell grep Warning test_ok.res | wc -l) Warnings."
+ grep Warning test_ok.res || true
+ /bin/echo -e "There were $(shell grep Error test_ok.res | wc -l) errors."
+ grep "*** Error" test_ok.res
+
+
+
+
+
+test_ec:
+ rm -f test_ec.res
+ for d in ${OK_LUS}; do \
+ /bin/echo -e "\n$(NL)====> $(LC0) --nonreg-test -ec $$d -o /tmp/xx.ec" >> test_ec.res; \
+ $(LC0) -ec --nonreg-test $$d -o /tmp/xx.ec >> test_ec.res 2>&1 ;\
+ /bin/echo -e "ec2c /tmp/xx.ec" >> test_ec.res; \
+ (ec2c /tmp/xx.ec >> test_ec.res 2>&1 && /bin/echo -n "ok ") || /bin/echo " KO ($$d)!";\
+ done; \
+ diff -u test_ec.res.exp test_ec.res > test_ec.diff || \
+ (cat test_ec.diff ; /bin/echo "cf test_ec.diff"; exit 1)
+
+
+utest_ec:
+ cp test_ec.res test_ec.res.exp
+
+test_lv4:
+ rm test_lv4.res || /bin/echo "";
+ for d in ${OK_LUS}; do \
+ /bin/echo -e "\n$(NL)====> $(LC0) --nonreg-test -lv4 $$d -o /tmp/xx.lus" >> test_lv4.res; \
+ $(LC0) --nonreg-test -lv4 $$d -o /tmp/xx.lus >> test_lv4.res 2>&1 ;\
+ if [ ! -f /tmp/xx.lus ]; then echo "Error $$d: no /tmp/xx.lus file" >> test_lv4.res 2>&1; fi ;\
+ for node in `lusinfo /tmp/xx.lus nodes`; do \
+ /bin/echo -e "lus2ec /tmp/xx.lus $$node" >> test_lv4.res; \
+ (lus2ec /tmp/xx.lus $$node >> \
+ test_lv4.res 2>&1 && /bin/echo -n "ok ") \
+ || /bin/echo " KO ($$d)!";\
+ done; \
+ done; \
+ diff -u test_lv4.res.exp test_lv4.res > test_lv4.diff || \
+ (cat test_lv4.diff ; /bin/echo "cf test_lv4.diff"; exit 1)
+
+
+utest_lv4:
+ cp test_lv4.res test_lv4.res.exp
+
+test: test_lic test_ec test_lv4
+utest: utest_lic utest_ec utest_lv4
+
+
+clean:
+ for d in ${ALL_LUS}; do \
+ rm $$d.lic; \
+ done
diff --git a/moretests/should_work/aliases/alias.lus b/moretests/should_work/aliases/alias.lus
new file mode 100644
index 0000000000000000000000000000000000000000..1fe4d82fba3d1c9b7350961a1f48e385f466ba1d
--- /dev/null
+++ b/moretests/should_work/aliases/alias.lus
@@ -0,0 +1,22 @@
+
+
+const toto = 42;
+
+const huit = 9; -- gnark gnark
+
+type t = enum { Bleu, Blanc };
+
+type a = int^toto;
+
+const c : t = Bleu;
+const c2 : t;
+
+type t1 = bool^4^5;
+
+type bool_4 ; -- Ah ah !!
+type bool_4a ; -- Ah ah !!
+type bool_4b ; -- Ah ah !!
+
+type str = { foo: t^toto^huit; bar : t1 };
+
+
diff --git a/moretests/should_work/aliases/ex.lus b/moretests/should_work/aliases/ex.lus
new file mode 100644
index 0000000000000000000000000000000000000000..6cd5764fc7c5f1810f97c561a64e7427d3ed182a
--- /dev/null
+++ b/moretests/should_work/aliases/ex.lus
@@ -0,0 +1,10 @@
+type
+ t = int^1^2^3^4;
+ t1 = t^4;
+ t2 = {a: int; b: bool^11^22};
+ s1 = {x:int; y:t};
+ s = {x:t; y:s1};
+node ex(a: s) returns (b: int);
+let
+ b = a.x[0][0][0][0] + a.y.y[0][0][0][0];
+tel
diff --git a/moretests/test.res.exp b/moretests/test.res.exp
new file mode 100644
index 0000000000000000000000000000000000000000..c864e7b309c3ebf964b4e88c462bed60a5bf6619
--- /dev/null
+++ b/moretests/test.res.exp
@@ -0,0 +1,73 @@
+Non-regression tests
+usage: lus2lic [options] <lustre files>
+where [options] can be:
+ --node <node>
+ -n <node>
+ Set the main node (all items are compiled if unset)
+ --output-file <file>
+ -o <file>
+ Set the output file name.
+ --keep-nested-calls
+ -knc
+ Keep nested calls. By default, only one node per equation is generated.
+ --expand-iterators
+ -ei
+ Expand array iterators (i.e., generate iterator-free code).
+ --expand-enums
+ -ee
+ Translate enums into integers.
+ --expand-structs-and-arrays
+ -esa
+ Expand structures and arrays using as many variables as necessary (automatically impose '-ei').
+ --expand-nodes
+ -en
+ Expand the main node (use the first node if no one is specified).
+ --do-not-expand-node <node>
+ -den <node>
+ Do not expand node (useful in the expand mode only of course).
+ --lustre-v4
+ -lv4
+ Use Lustre V4 syntax (automatically impose '-ei -ee -esa').
+ --expanded-code
+ -ec
+ Generate ec (actually just an alias for '-en -lv4 --no-prefix').
+ -np
+ --no-prefix
+ Do not prefix variable names by their module (beware: variable names may clash with this option).
+ --test-lexer Internal option used to test the lexer
+ -tlex
+ --verbose-level <int>
+ -vl <int>
+ Set the verbose level.
+ --verbose
+ -v
+ Set the verbose level to 1.
+ --version
+ -version
+ Display the current version of the tool.
+ -unit
+ Run some (internal) unit tests
+ --nonreg-test
+ -h
+ -help
+ --help
+ Display this message.
+
+----------------------------------------------------------------------
+====> ../obj/lus2lic -vl 2 --nonreg-test should_work/aliases/alias.lus
+-- ../obj/lus2lic -vl 2 --nonreg-test should_work/aliases/alias.lus
+type alias::a = int^42;
+type alias::bool_4;
+type alias::bool_4a;
+type alias::bool_4b;
+type alias::bool_4c = bool^4 (*abstract in the source*);
+type alias::bool_4c_5 = alias::bool_4c^5 (*abstract in the source*);
+type alias::str = struct {foo : alias::t_42_9; bar : alias::bool_4c_5};
+type alias::t = enum {alias::Bleu, alias::Blanc};
+type alias::t1 = alias::bool_4c^5;
+type alias::t_42 = alias::t^42 (*abstract in the source*);
+type alias::t_42_9 = alias::t_42^9 (*abstract in the source*);
+const alias::c2 : alias::t;
+const alias::huit = 9;
+const alias::toto = 42;
+Those tests are supposed to generate errors
diff --git a/src/doAliasTypes.ml b/src/doAliasTypes.ml
index a429b7a2a2445629f5ecad782a5d3b37560a2d8a..6be57ec6a407ebfeccd328598b7012d7a35b955f 100644
--- a/src/doAliasTypes.ml
+++ b/src/doAliasTypes.ml
@@ -10,15 +10,17 @@ open Eff
let doit (inp : LicPrg.t) : LicPrg.t =
- let res = ref inp in
(* n.b. on fait un minumum d'effet de bord pour
pas avoir trop d'acummulateur ... *)
+ let atab = Hashtbl.create 10 in
+ let res = ref inp in
(** UTILE : nommage des alias d'array *)
let array_ident ty sz =
let tid = Eff.ident_of_type ty in
- let id = Printf.sprintf "%s_%d" (snd tid) sz in
- Ident.make_long (fst tid) id
+ let sfx = Printf.sprintf "%s_%d" (snd tid) sz in
+ let id = LicPrg.fresh_type_id !res (fst tid) sfx in
+ id
in
(** UTILE : cherche/crée un alias de type *)
@@ -26,22 +28,31 @@ let doit (inp : LicPrg.t) : LicPrg.t =
match te with
| Array_type_eff (ty, sz) -> (
let ty = alias_type ty in
- let id = array_ident ty sz in
let te = Array_type_eff (ty, sz) in
- let ref_te = Abstract_type_eff (id, te) in
+ try
+ let ref_te = Hashtbl.find atab te in
(*
-Verbose.printf "-> alias_type %s gives id=%s ref=%s\n"
+Verbose.printf "--> alias_type %s = %s ^ %d FOUND : %s\n"
(LicDump.string_of_type_eff te)
-(Ident.string_of_long id)
+(LicDump.string_of_type_eff ty)
+sz
(LicDump.string_of_type_eff ref_te);
*)
- try
- let te' = LicPrg.find_type !res id in
- assert (te' = ref_te);
- ref_te
- with Not_found ->
- res := LicPrg.add_type id ref_te !res;
ref_te
+ with Not_found -> (
+ let id = array_ident ty sz in
+ let ref_te = Abstract_type_eff (id, te) in
+ res := LicPrg.add_type id ref_te !res;
+ Hashtbl.add atab te ref_te;
+(*
+Verbose.printf "--> alias_type %s = %s ^ %d NOT FOUND, gives: %s\n"
+(LicDump.string_of_type_eff te)
+(LicDump.string_of_type_eff ty)
+sz
+(LicDump.string_of_type_eff ref_te);
+*)
+ ref_te
+ )
) | _ -> te
in
diff --git a/src/licDump.ml b/src/licDump.ml
index 39cb78681b28235e8b370c05ac4e298b7c733db5..5967eae16039e0867b481b21684fac061f78dae2 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -43,9 +43,6 @@ let rec (is_a_tuple : Eff.val_exp -> bool) =
| _ -> false
(******************************************************************************)
-(* prefix used to prefix user type name in order to avoid name clashed with
- the alias type name that are generated by the compiler. *)
-let prefix = "_"
let rec string_of_const_eff =
function
@@ -139,7 +136,7 @@ and string_def_of_type_eff = function
| Int_type_eff -> "int"
| Real_type_eff -> "real"
| External_type_eff (i) -> dump_long i
- | Abstract_type_eff (i, t) -> string_def_of_type_eff t ^ " -- abstract in the source "
+ | Abstract_type_eff (i, t) -> string_def_of_type_eff t ^ " (*abstract in the source*)"
| Enum_type_eff (i, sl) ->
assert (sl <>[]);
if !Global.expand_enums then
@@ -170,17 +167,17 @@ and string_of_type_eff = function
| Bool_type_eff -> "bool"
| Int_type_eff -> "int"
| Real_type_eff -> "real"
- | External_type_eff (name) -> prefix ^ (dump_long name)
- | Abstract_type_eff (name, t) -> prefix ^ (dump_long name)
+ | External_type_eff (name) -> (dump_long name)
+ | Abstract_type_eff (name, t) -> (dump_long name)
(* string_of_type_eff t *)
- | Enum_type_eff (name, _) -> prefix ^ (dump_long name)
+ | Enum_type_eff (name, _) -> (dump_long name)
(*
OBSOLETE
| Array_type_eff (ty, sz) -> array_alias ty sz
*)
| Array_type_eff (ty, sz) ->
- Printf.sprintf "%s%s^%d" prefix (string_of_type_eff ty) sz
- | Struct_type_eff (name, _) -> prefix ^ (dump_long name)
+ Printf.sprintf "%s^%d" (string_of_type_eff ty) sz
+ | Struct_type_eff (name, _) -> (dump_long name)
| Any -> "any"
(* assert false *)
(* string_of_type_eff (Polymorphism.get_type ()) *)
@@ -193,12 +190,12 @@ and string_of_type_eff4msg = function
| Bool_type_eff -> "bool"
| Int_type_eff -> "int"
| Real_type_eff -> "real"
- | External_type_eff (name) -> prefix ^ (dump_long name)
- | Abstract_type_eff (name, t) -> prefix ^ (dump_long name)
+ | External_type_eff (name) -> (dump_long name)
+ | Abstract_type_eff (name, t) -> (dump_long name)
(* string_of_type_eff4msg t *)
- | Enum_type_eff (name, _) -> prefix ^ (dump_long name)
+ | Enum_type_eff (name, _) -> (dump_long name)
| Array_type_eff (ty, sz) -> (string_of_type_eff4msg ty) ^ "^" ^(string_of_int sz)
- | Struct_type_eff (name, _) -> prefix ^ (dump_long name)
+ | Struct_type_eff (name, _) -> (dump_long name)
| Any -> "'a"
| Overload -> "'o"
@@ -536,7 +533,7 @@ and string_of_val_exp_eff_core ve_core =
| CallByNameEff(by_name_op_eff, fl) ->
(match by_name_op_eff.it with
- | STRUCT (pn,idref) -> prefix ^ (
+ | STRUCT (pn,idref) -> (
match Ident.pack_of_idref idref with
| Some pn ->
Ident.string_of_idref idref
@@ -619,7 +616,7 @@ and (string_of_node_def : Eff.node_def -> string list) =
(* exported *)
and (type_decl: Ident.long -> Eff.type_ -> string) =
fun tname teff ->
- "type " ^ prefix ^ (dump_long tname) ^
+ "type " ^ (dump_long tname) ^
(match teff with
| Enum_type_eff (_) ->
if !Global.expand_enums then ";\n" else
diff --git a/src/licPrg.ml b/src/licPrg.ml
index 014f149fe7608d8714285fcafc9a8684b59025ba..64fcde38af2811b73ae66e7d844fb61ddb85c322 100644
--- a/src/licPrg.ml
+++ b/src/licPrg.ml
@@ -54,6 +54,29 @@ let empty = {
nodes = NodeKeyMap.empty
}
+(* KoKêterie : pour changer ds suffixes
+ numériques, produit :
+ a, b, c, d, e, aa, ab, ac, ad, ae, etc ...
+Pour tester :
+for i = 0 to 42 do
+Printf.printf "%3d -> %s\n" i (pretty_sfx i)
+done
+*)
+let rec pretty_sfx i =
+ if i = 0 then ""
+ else
+ (pretty_sfx ((i-1)/5))^(Char.escaped (char_of_int (97 + (i-1) mod 5)))
+
+(** CREER DES IDENTS TOUT FRAIS *)
+let fresh_type_id this pname pfx =
+ let rec fresh x =
+ let id = Printf.sprintf "%s%s" pfx (pretty_sfx x) in
+ let res = Ident.make_long pname id in
+ if ItemKeyMap.mem res this.types then fresh (x+1)
+ else res
+ in
+ fresh 0
+
(** RECHERCHE *)
let find_type this k = ItemKeyMap.find k this.types
let find_const this k = ItemKeyMap.find k this.consts
diff --git a/src/licPrg.mli b/src/licPrg.mli
index 5925a6bc065eefafae43fb17b4b37646b562a746..35e2d4376d8b3a1b65f4f96592a1a5724ed023b5 100644
--- a/src/licPrg.mli
+++ b/src/licPrg.mli
@@ -22,3 +22,5 @@ val to_file : out_channel -> t -> unit
val find_type : t -> Eff.item_key -> Eff.type_
val find_const : t -> Eff.item_key -> Eff.const
val find_node : t -> Eff.node_key -> Eff.node_exp
+
+val fresh_type_id : t -> Ident.pack_name -> string -> Ident.long