When including files with a relative path, consider it as relative to

the includer file, instead of the compiling directory.

Also, avoid loops when including files.

Add a --nonreg-test option that prevent the compiler to print file
name paths in error messages. Indeed, this change makes all file
names absolute, which complicates the non-regression tests automatic
perusal.

src/Makefile

@@ -12,6 +12,8 @@ SOURCES =  \
 	./version.ml \
 	./verbose.mli \
 	./verbose.ml \
+	./filenameExtras.mli \
+	./filenameExtras.ml \
 	./global.ml \
 	./ident.mli \
 	./ident.ml \

src/filenameExtras.ml

+(** Time-stamp: <modified the 19/08/2010 (at 16:11) by Erwan Jahier> *)
+
+
+let (to_list : string -> string list) =
+  fun f -> 
+    let rec aux acc f =
+      let dir = Filename.dirname f
+      and base = Filename.basename f in
+        if dir = f then dir::acc else
+          aux (base::acc) dir
+    in
+      aux [] f
+        
+
+(* exported *)
+let (simplify : string -> string) =
+  fun f -> 
+    let rec simplify_aux l =
+      match l with
+        | []
+        | _::[] -> l
+        | x1::x2::tail -> 
+            if x1 = Filename.current_dir_name then
+              simplify_aux (x2::tail)
+            else if x1 = Filename.parent_dir_name then 
+              (* x1=.. -> nothing to do *)
+              x1 :: (simplify_aux (x2::tail))
+            else if x2 = Filename.parent_dir_name then
+              (* "x1/.." -> we simplify into "" *)
+              simplify_aux tail
+            else
+              (* x2 maybe also be ".." after simplifications -> fixpointing *)
+              match simplify_aux (x2::tail) with
+                | [] -> [] (* dead code *)
+                | head::tail -> 
+                    if head = Filename.parent_dir_name then 
+                      tail (* bingo! we simplify *)
+                    else
+                      x1::head::tail
+    in
+    let l = to_list f in
+    let l = 
+      match l with
+        | [] -> []
+        | head::tail -> 
+            (* simplify_aux removes all the "." in the path, so we preserve the first
+               one here if necessary *)
+            if head = Filename.current_dir_name then  
+              head::(simplify_aux tail) 
+            else
+              simplify_aux l
+    in
+      (* build the filename back *)
+      List.fold_left (fun x acc -> Filename.concat x acc) (List.hd l) (List.tl l)
+
+
+(* A few unit tests *)
+let _ = 
+  assert(simplify "/home/name/dir/file" = "/home/name/dir/file");
+  assert(simplify "/home/name/dir/../file" = "/home/name/file");
+  assert(simplify "/home/name/dir/../../file" = "/home/file");
+  assert(simplify "/home/./name/././././dir/.././../file" = "/home/file");
+  assert(simplify "" = "./."); (* hum, that one is not simpler... *)
+  assert(simplify "./a/b/../../../x" = "./../x")

src/filenameExtras.mli

+(** Time-stamp: <modified the 19/08/2010 (at 16:06) by Erwan Jahier> *)
+
+(* Completing the Filename module... *)
+
+
+(* Simplify the path of a file name.
+
+   For instance, in posix, "./x/../file.ext" is simplified into  "./file.ext"
+*)
+val simplify : string -> string

src/global.ml

-(** Time-stamp: <modified the 05/05/2010 (at 15:39) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/08/2010 (at 16:57) by Erwan Jahier> *)
 
 (** Some global variables. *)
 
@@ -23,7 +23,7 @@ let expand_structs = ref false
 (* the output channel *)
 let oc = ref Pervasives.stdout
 let tlex = ref false
-
+let nonreg_test = ref false
 (* those functions are here as they modify some global vars *)
 
 let add_infile file_name =

src/lxm.ml

-(** Time-stamp: <modified the 01/09/2008 (at 17:03) by jahier> *)
+(** Time-stamp: <modified the 19/08/2010 (at 17:00) by Erwan Jahier> *)
 
 (** Common to lus2lic and lic2loc  *)
 
@@ -31,8 +31,14 @@ let file x = x._file
 let pragma x = x._pragma
 (* affichage standard: *)
 let details lxm = (
-  Printf.sprintf "in file \"%s\", line %d, col %d to %d, token '%s'"
-    lxm._file lxm._line lxm._cstart lxm._cend lxm._str 
+  let file = if !Global.nonreg_test then 
+    (* during non-regression test, having absolute paths printed complicate the perusal. *)
+    Filename.basename lxm._file 
+  else 
+    lxm._file 
+  in
+    Printf.sprintf "in file \"%s\", line %d, col %d to %d, token '%s'"
+      file lxm._line lxm._cstart lxm._cend lxm._str 
 )
 let position lxm = (
   Printf.sprintf "line:%d, col:%d to %d"

src/main.ml

-(** Time-stamp: <modified the 05/05/2010 (at 16:03) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/08/2010 (at 17:44) by Erwan Jahier> *)
 
 (** Here follows a description of the different modules used by this lus2lic compiler.
 
@@ -147,9 +147,6 @@ let rec arg_list = [
     "\n\t Generate ec (actually just an alias for '-en -lv4')."
   );
 
-  ( "-unit", Arg.Unit (fun x -> Global.run_unit_test := true),
-    "\n\t Run some (internal) unit tests"
-  );
 
   ("--test-lexer",Arg.Set Global.tlex,"Internal option used to test the lexer");
   ("-tlex",Arg.Set Global.tlex,"");
@@ -174,6 +171,12 @@ let rec arg_list = [
     "\n\t Display the current version of the tool."
   );
 
+  ( "-unit", Arg.Unit (fun x -> Global.run_unit_test := true),
+    "\n\t Run some (internal) unit tests"
+  );
+
+  ("--nonreg-test", Arg.Unit(fun _ -> Global.nonreg_test := true),
+   "");
 
   ("-h", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)), "" );
   ("-help", Arg.Unit (fun _ -> (Arg.usage arg_list usage_msg; exit 0)),"" );
@@ -213,15 +216,26 @@ type maybe_packed =
   | Packed of SyntaxTree.pack_or_model
   | Unpacked of SyntaxTree.packbody 
 
+
+
 let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
   fun infile_list -> 
     let (get_one_source : string -> string list * maybe_packed list) = 
       fun infile -> 
-        let lexbuf = Global.lexbuf_of_file_name infile in
-          if !Global.tlex then test_lex lexbuf;
-          match (lus_load lexbuf) with
-            | PRPackBody(incl_files, pbdy) -> incl_files, [Unpacked pbdy]
-            | PRPack_or_models(incl_files, nsl) -> incl_files, (List.map (fun ns -> Packed ns) nsl)
+        let incl_files, l =
+          let lexbuf = Global.lexbuf_of_file_name infile in
+            if !Global.tlex then test_lex lexbuf;
+            match (lus_load lexbuf) with
+              | PRPackBody(incl_files, pbdy) -> incl_files, [Unpacked pbdy]
+              | PRPack_or_models(incl_files, nsl) -> incl_files, (List.map (fun ns -> Packed ns) nsl)
+        in
+          (* If included files have a relative path, strange things may happen.
+             Hence we make the path absolute, using the directory of the includer.
+          *)
+        let includer_dir = Filename.dirname infile in
+        let fix_dir f = if Filename.is_relative f then Filename.concat includer_dir f else f in
+        let incl_files = List.map fix_dir incl_files in
+          incl_files, l
     in
     let rec (get_remaining_source_list : maybe_packed list * string list * string list -> 
               maybe_packed list * string list * string list) =
@@ -229,6 +243,7 @@ let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
         match to_be_compiled with
           | [] -> (pack_acc, compiled, [])
           | infile::tail ->
+              let infile = FilenameExtras.simplify infile in
               if List.mem infile compiled then
                 get_remaining_source_list (pack_acc, compiled, tail)
               else
@@ -239,6 +254,19 @@ let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
                     infile::compiled, 
                     tail@included_files)
     in
+    let infile_list = 
+      (* We need absolute paths to make sure that files are not
+         included several times.  Indeed, otherwise,
+         FilenameExtras.simplify may miss some simplifications.  For
+         example, consider the files "../../x/toto.lus" and
+         "../toto.lus".  They actually refer to the same file if the
+         current directory is a sub-directory of "x". Working with
+         absolute paths solves the problem.
+         
+      *)
+      let make_it_absolute f = if Filename.is_relative f then Filename.concat (Sys.getcwd ()) f else f in
+        List.map make_it_absolute infile_list
+    in
     let first_file = assert (infile_list <> []); List.hd infile_list in
     let included_files, first_pack = get_one_source first_file in
     let (pack_list, _compiled_files, included_files) = 

src/test/Makefile

-LC0=../lus2lic
+LC0=../lus2lic  
 LC=../lus2lic -vl 2
 LC2=../lus2lic
 
@@ -52,7 +52,7 @@ help:
 version:
 	$(LC0) --version 
 
-FILTER= grep -v "file was generated by" | grep -v " on "
+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
@@ -62,12 +62,12 @@ same_file:
 
 test_lic: begin unit help version do_not_exist same_file
 	for d in ${OK_LUS}; do \
-		echo -e "\n$(NL)====> $(LC) $$d" >> test_ok.res; \
-		$(LC) $$d >> test_ok.res 2>&1 ;\
+		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 \
-		echo -e  "\n$(NL)====> $(LC) $$d" >> test_ko.res; \
-		$(LC) $$d >> test_ko.res 2>&1 ;\
+		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 || \
@@ -93,8 +93,8 @@ errors:errors_nb
 test_ec: 
 	rm -f test_ec.res
 	for d in ${OK_LUS}; do \
-		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 "\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 ;\
 		echo -e "ec2c /tmp/xx.ec" >> test_ec.res; \
 		(ec2c /tmp/xx.ec >> test_ec.res 2>&1 && echo -n "ok ") || echo " KO ($$d)!";\
 	done; \
@@ -108,8 +108,8 @@ utest_ec:
 test_lv4: 
 	rm test_lv4.res || echo "";
 	for d in ${OK_LUS}; do \
-		echo -e "\n$(NL)====> $(LC) -lv4 $$d -o /tmp/xx.lus" >> test_lv4.res; \
-		$(LC0) -lv4 $$d -o /tmp/xx.lus >> test_lv4.res 2>&1 ;\
+		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 ;\
 		for node in `lusinfo /tmp/xx.lus nodes`; do \
 			echo -e "lus2ec /tmp/xx.lus $$node" >> test_lv4.res; \
 			(lus2ec /tmp/xx.lus $$node >> \

src/test/should_work/packEnvTest/contractForElementSelectionInArray/main.lus

-include "should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus"
+include "packageTableau.lus"
 
 package util
  provides node igt(i, j: int) returns (res: bool);