driver: fix path simplification with ..; add missing directory separator.

2 files changed, 46 insertions, 42 deletions

diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index 1eab18d49..6ffeef8a3 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -952,7 +952,8 @@ package body Ghdldrv is
          Add_File_List (Filelist_Name.all, True);
       end if;
       Last_File := Filelist.Last;
-      Add_File_List (Get_Machine_Path_Prefix & "grt" & List_Suffix, False);
+      Add_File_List (Get_Machine_Path_Prefix & Directory_Separator
+                       & "grt" & List_Suffix, False);
 
       --  call the linker
       declare
@@ -970,7 +971,7 @@ package body Ghdldrv is
          P := P + 3;
          if Add_Std then
             Std_File := new
-              String'(Get_Machine_Path_Prefix
+              String'(Get_Machine_Path_Prefix & Directory_Separator
                       & Get_Version_Path & Directory_Separator
                       & "std" & Directory_Separator
                       & "std_standard" & Link_Obj_Suffix.all);
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index 568f93bbe..804d42361 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -206,18 +206,18 @@ package body Ghdllocal is
 
    procedure Set_Prefix_From_Program_Path (Prog_Path : String)
    is
-      Dir_Pos : Natural;
+      Last : Natural;
    begin
-      Dir_Pos := Get_Basename_Pos (Prog_Path);
-      if Dir_Pos = 0 then
+      Last := Get_Basename_Pos (Prog_Path);
+      if Last = 0 then
          --  No directory in Prog_Path.  This is not expected.
          return;
       end if;
 
       declare
          Pathname : String :=
-           Normalize_Pathname (Prog_Path (Dir_Pos + 1 .. Prog_Path'Last),
-                               Prog_Path (Prog_Path'First .. Dir_Pos - 1));
+           Normalize_Pathname (Prog_Path (Last + 1 .. Prog_Path'Last),
+                               Prog_Path (Prog_Path'First .. Last - 1));
          Pos : Natural;
       begin
          --  Stop now in case of error.
@@ -226,30 +226,28 @@ package body Ghdllocal is
          end if;
 
          --  Skip executable name
-         Dir_Pos := Get_Basename_Pos (Pathname);
-         if Dir_Pos = 0 then
+         Last := Get_Basename_Pos (Pathname);
+         if Last = 0 then
             return;
          end if;
 
          --  Simplify path:
          --    /./ => /
          --    // => /
-         Pos := Dir_Pos - 1;
+         Pos := Last - 1;
          while Pos >= Pathname'First loop
             if Is_Directory_Separator (Pathname (Pos)) then
                if Is_Directory_Separator (Pathname (Pos + 1)) then
                   --  // => /
-                  Pathname (Pos .. Dir_Pos - 1) :=
-                    Pathname (Pos + 1 .. Dir_Pos);
-                  Dir_Pos := Dir_Pos - 1;
-               elsif Pos + 2 <= Dir_Pos
+                  Pathname (Pos .. Last - 1) := Pathname (Pos + 1 .. Last);
+                  Last := Last - 1;
+               elsif Pos + 2 <= Last
                  and then Pathname (Pos + 1) = '.'
                  and then Is_Directory_Separator (Pathname (Pos + 2))
                then
                   --  /./ => /
-                  Pathname (Pos .. Dir_Pos - 2) :=
-                    Pathname (Pos + 2 .. Dir_Pos);
-                  Dir_Pos := Dir_Pos - 2;
+                  Pathname (Pos .. Last - 2) := Pathname (Pos + 2 .. Last);
+                  Last := Last - 2;
                end if;
             end if;
             Pos := Pos - 1;
@@ -257,54 +255,59 @@ package body Ghdllocal is
 
          --  Simplify path:
          --    /xxx/../ => /
+         --  Do it forward as xxx/../../ must not be simplified as xxx/
          --  This is done after the previous simplication to avoid to deal
          --  with cases like /xxx//../ or /xxx/./../
-         Pos := Dir_Pos - 3;
-         while Pos >= Pathname'First loop
+         Pos := Pathname'First;
+         Ada.Text_IO.Put_Line (Pathname (Pathname'First .. Last));
+         while Pos <= Last - 3 loop
             if Is_Directory_Separator (Pathname (Pos))
               and then Pathname (Pos + 1) = '.'
               and then Pathname (Pos + 2) = '.'
               and then Is_Directory_Separator (Pathname (Pos + 3))
             then
                declare
-                  Pos2 : constant Natural :=
-                    Get_Basename_Pos (Pathname (Pathname'First .. Pos - 1));
-                  --  /xxxxxxxxxx/../
-                  --  ^          ^
-                  --  Pos2       Pos
+                  Last_Dir : Natural;
                   Len : Natural;
                begin
-                  if Pos2 = 0 then
-                     --  Shouldn't happen.
-                     return;
-                  end if;
-                  Len := Pos + 3 - Pos2;
-                  Pathname (Pos2 + 1 .. Dir_Pos - Len) :=
-                    Pathname (Pos + 4 .. Dir_Pos);
-                  Dir_Pos := Dir_Pos - Len;
-                  if Pos2 < Pathname'First + 3 then
-                     exit;
-                  end if;
-                  Pos := Pos2 - 3;
+                  --  Search backward
+                  Last_Dir := Pos;
+                  loop
+                     if Last_Dir = Pathname'First then
+                        Last_Dir := Pos;
+                        exit;
+                     end if;
+                     Last_Dir := Last_Dir - 1;
+                     exit when Is_Directory_Separator (Pathname (Last_Dir));
+                  end loop;
+
+                  --  /xxxxxxxxxx/../
+                  --  ^          ^
+                  --  Last_Dir   Pos
+                  Len := Pos + 3 - Last_Dir;
+                  Pathname (Last_Dir + 1 .. Last - Len) :=
+                    Pathname (Pos + 4 .. Last);
+                  Last := Last - Len;
+                  Pos := Last_Dir;
                end;
             else
-               Pos := Pos - 1;
+               Pos := Pos + 1;
             end if;
          end loop;
 
          --  Remove last '/'
-         Dir_Pos := Dir_Pos - 1;
+         Last := Last - 1;
 
          --  Skip '/bin' directory if present
-         Pos := Get_Basename_Pos (Pathname (Pathname'First .. Dir_Pos));
+         Pos := Get_Basename_Pos (Pathname (Pathname'First .. Last));
          if Pos = 0 then
             return;
          end if;
-         if To_Lower (Pathname (Pos + 1 .. Dir_Pos)) = "bin" then
-            Dir_Pos := Pos - 1;
+         if To_Lower (Pathname (Pos + 1 .. Last)) = "bin" then
+            Last := Pos - 1;
          end if;
 
-         Exec_Prefix := new String'(Pathname (Pathname'First .. Dir_Pos));
+         Exec_Prefix := new String'(Pathname (Pathname'First .. Last));
       end;
    end Set_Prefix_From_Program_Path;