diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-11-08 07:14:16 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-11-08 07:14:16 +0100 |
commit | 48b903f6a88e53611ba385706df1ba85bc9efbca (patch) | |
tree | a9532396096c83653a046ee2da2f2413ae26abcc | |
parent | 4ef1adc1294c586f683a20a488120e6e42b4e6e2 (diff) | |
download | ghdl-48b903f6a88e53611ba385706df1ba85bc9efbca.tar.gz ghdl-48b903f6a88e53611ba385706df1ba85bc9efbca.tar.bz2 ghdl-48b903f6a88e53611ba385706df1ba85bc9efbca.zip |
driver: fix path simplification with ..; add missing directory separator.
-rw-r--r-- | src/ghdldrv/ghdldrv.adb | 5 | ||||
-rw-r--r-- | src/ghdldrv/ghdllocal.adb | 83 |
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; |