ghdldrv: compile elab file in output directory.

Ticket 87.

3 files changed, 39 insertions, 23 deletions

diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index ce20e2cc8..b92a02eb8 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -132,7 +132,8 @@ package body Ghdldrv is
    end My_Spawn;
 
    --  Compile FILE with additional argument OPTS.
-   procedure Do_Compile (Options : Argument_List; File : String)
+   procedure Do_Compile
+     (Options : Argument_List; File : String; In_Work : Boolean)
    is
       Obj_File : String_Access;
       Asm_File : String_Access;
@@ -142,7 +143,7 @@ package body Ghdldrv is
       --  Create post file.
       case Compile_Kind is
          when Compile_Debug =>
-            Post_File := Append_Suffix (File, Post_Suffix);
+            Post_File := Append_Suffix (File, Post_Suffix, In_Work);
          when others =>
             null;
       end case;
@@ -151,14 +152,14 @@ package body Ghdldrv is
       case Compile_Kind is
          when Compile_Gcc
            | Compile_Debug =>
-            Asm_File := Append_Suffix (File, Asm_Suffix);
+            Asm_File := Append_Suffix (File, Asm_Suffix, In_Work);
          when Compile_Llvm
            | Compile_Mcode =>
             null;
       end case;
 
       --  Create obj file (may not be used, but the condition isn't simple).
-      Obj_File := Append_Suffix (File, Get_Object_Suffix.all);
+      Obj_File := Append_Suffix (File, Get_Object_Suffix.all, In_Work);
 
       --  Compile.
       declare
@@ -746,7 +747,7 @@ package body Ghdldrv is
       Setup_Compiler (False);
 
       for I in Args'Range loop
-         Do_Compile (Nil_Opt, Args (I).all);
+         Do_Compile (Nil_Opt, Args (I).all, True);
       end loop;
    end Perform_Action;
 
@@ -781,7 +782,13 @@ package body Ghdldrv is
       --  Set a name for the elaboration files.  Use the basename of the
       --  output file, so that parallel builds with different output files
       --  are allowed.
-      Elab_Name := new String'(Elab_Prefix & Get_Base_Name (Output_File.all));
+      declare
+         Dir_Pos : constant Natural := Get_Basename_Pos (Output_File.all);
+      begin
+         Elab_Name := new String'
+           (Output_File (Output_File'First .. Dir_Pos)
+              & Elab_Prefix & Output_File (Dir_Pos + 1 .. Output_File'Last));
+      end;
    end Set_Elab_Units;
 
    procedure Set_Elab_Units (Cmd_Name : String; Args : Argument_List)
@@ -805,7 +812,7 @@ package body Ghdldrv is
       Comp_List (2) := Unit_Name;
       Comp_List (3) := new String'("-l");
       Comp_List (4) := Filelist_Name;
-      Do_Compile (Comp_List, Elab_Name.all);
+      Do_Compile (Comp_List, Elab_Name.all, False);
       Free (Comp_List (3));
       Free (Comp_List (1));
    end Bind;
@@ -822,15 +829,14 @@ package body Ghdldrv is
          Comp_List (Index) := new String'("--ghdl-source=" & Files (I).all);
          Index := Index + 1;
       end loop;
-      Do_Compile (Comp_List, Elab_Name.all);
+      Do_Compile (Comp_List, Elab_Name.all, False);
       Free (Comp_List (1));
       for I in 3 .. Comp_List'Last loop
          Free (Comp_List (I));
       end loop;
    end Bind_Anaelab;
 
-   procedure Link (Add_Std : Boolean;
-                   Disp_Only : Boolean)
+   procedure Link (Add_Std : Boolean; Disp_Only : Boolean)
    is
       Last_File : Natural;
    begin
@@ -852,7 +858,7 @@ package body Ghdldrv is
          Obj_File : String_Access;
          Std_File : String_Access;
       begin
-         Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all);
+         Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all, False);
          P := 0;
          Args (P + 1) := Dash_o;
          Args (P + 2) := Output_File;
@@ -1416,7 +1422,7 @@ package body Ghdldrv is
             end if;
 
             if In_Work then
-               Do_Compile (Nil_Args, Image (File_Id));
+               Do_Compile (Nil_Args, Image (File_Id), True);
             else
                declare
                   use Libraries;
@@ -1437,7 +1443,7 @@ package body Ghdldrv is
                      Lib_Args (2) := new String'
                        ("--workdir=" & Image (Work_Directory));
                   end if;
-                  Do_Compile (Lib_Args, Image (File_Id));
+                  Do_Compile (Lib_Args, Image (File_Id), True);
 
                   Work_Directory := Prev_Workdir;
 
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index 8e2eceb94..841971539 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -182,7 +182,7 @@ package body Ghdllocal is
             return I;
          end if;
       end loop;
-      return 0;
+      return Pathname'First - 1;
    end Get_Basename_Pos;
 
    --  Simple lower case conversion, used to compare with "bin".
@@ -207,7 +207,7 @@ package body Ghdllocal is
       Last : Natural;
    begin
       Last := Get_Basename_Pos (Prog_Path);
-      if Last = 0 then
+      if Last < Prog_Path'First then
          --  No directory in Prog_Path.  This is not expected.
          return;
       end if;
@@ -225,7 +225,7 @@ package body Ghdllocal is
 
          --  Skip executable name
          Last := Get_Basename_Pos (Pathname);
-         if Last = 0 then
+         if Last < Pathname'First then
             return;
          end if;
 
@@ -297,7 +297,7 @@ package body Ghdllocal is
 
          --  Skip '/bin' directory if present
          Pos := Get_Basename_Pos (Pathname (Pathname'First .. Last));
-         if Pos = 0 then
+         if Pos < Pathname'First then
             return;
          end if;
          if To_Lower (Pathname (Pos + 1 .. Last)) = "bin" then
@@ -323,7 +323,7 @@ package body Ghdllocal is
 
       --  If the command name is a relative path, deduce prefix from it
       --  and current path.
-      if Get_Basename_Pos (Prog_Path) /= 0 then
+      if Get_Basename_Pos (Prog_Path) >= Prog_Path'First then
          if Is_Executable_File (Prog_Path) then
             Set_Prefix_From_Program_Path
               (Get_Current_Dir & Directory_Separator & Prog_Path);
@@ -559,12 +559,18 @@ package body Ghdllocal is
       return Filename (First .. Last);
    end Get_Base_Name;
 
-   function Append_Suffix (File : String; Suffix : String) return String_Access
+   function Append_Suffix
+     (File : String; Suffix : String; In_Work : Boolean := True)
+     return String_Access
    is
       use Name_Table;
       Basename : constant String := Get_Base_Name (File);
    begin
-      Image (Libraries.Work_Directory);
+      if In_Work then
+         Image (Libraries.Work_Directory);
+      else
+         Nam_Length := Nam_Buffer'First - 1;
+      end if;
       Nam_Buffer (Nam_Length + 1 .. Nam_Length + Basename'Length) :=
         Basename;
       Nam_Length := Nam_Length + Basename'Length;
diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads
index 7c5d19319..b051aaef2 100644
--- a/src/ghdldrv/ghdllocal.ads
+++ b/src/ghdldrv/ghdllocal.ads
@@ -71,11 +71,15 @@ package Ghdllocal is
    function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
                           return String;
 
-   --  Get the position of the last directory separator or 0 if none.
+   --  Get the position of the last directory separator or Pathname'First - 1
+   --  if none.
    function Get_Basename_Pos (Pathname : String) return Natural;
 
-   function Append_Suffix (File : String; Suffix : String)
-                          return String_Access;
+   --  Build a filename based on FILE: append SUFFIX as extension, and
+   --  if IN_WORK is true prepend the workdir.
+   function Append_Suffix
+     (File : String; Suffix : String; In_Work : Boolean := True)
+     return String_Access;
 
    --  Return TRUE is UNIT can be at the apex of a design hierarchy.
    function Is_Top_Entity (Unit : Iir) return Boolean;