------------------------------------------------------------------------------
--                                                                          --
--                          AUNITSTUB COMPONENTS                            --
--                                                                          --
--                A U N I T S T U B . E N V I R O N M E N T                 --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2008-2011, AdaCore                     --
--                                                                          --
-- AUNITSTUB is  free  software;  you  can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software  Foundation;  either  version  2, or (at your option) any later --
-- version.  AUNITSTUB  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public License distributed with GNAT; see file COPYING. If --
-- not, write to the  Free  Software  Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.,                                      --
--                                                                          --
-- AUNITSTUB is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Text_IO;                use Ada.Text_IO;
with Ada.Strings;                use Ada.Strings;
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;

with Asis.Ada_Environments;      use Asis.Ada_Environments;

with GNAT.Command_Line;          use GNAT.Command_Line;
with GNAT.Directory_Operations;  use GNAT.Directory_Operations;

with ASIS_UL.Common;
with ASIS_UL.Compiler_Options;   use ASIS_UL.Compiler_Options;
with ASIS_UL.Debug;              use ASIS_UL.Debug;

with AUnitStub.Options;          use AUnitStub.Options;
with AUnitStub.Common;           use AUnitStub.Common;
with AUnitStub.Source_Table;     use AUnitStub.Source_Table;

with GNATCOLL.Projects;          use GNATCOLL.Projects;
with GNATCOLL.VFS;               use GNATCOLL.VFS;

package body AUnitStub.Environment is

   Parameter_Error : exception;
   --  Is raised if the initialization is impossible or fails down because of
   --  any reason

   Output_M : Output_Mode := Default_Output_Mode;

   Run_Dir : String_Access;
   --  Directory from which the tool was called.

   --  Project support
   Source_Project_Tree : GNATCOLL.Projects.Project_Tree;
   --  Source project file name. Used for extraction of source files and
   --  paths for compiler.

   Recursive_Sources : Boolean := False;

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Scan_Parameters;
   --  Scans the command-line parameters and sets the metrics to compute and
   --  sources to process.

   procedure Read_Args_From_File (Par_File_Name : String);
   --  Reads argument files from the file. Performs the same checks as when
   --  file names are read from the command line. This procedure assumes that
   --  the file named by Par_File_Name contains argument file names separated
   --  by one or more spaces.

   procedure Check_Parameters;
   --  Checks that parameter settings are compatible. Raises Parameter_Error
   --  and generates the diagnostic message if the check fails.

   function Detect_Predefined_Project_Path return File_Array_Access;
   --  Returns an array of default directories where compiler can search for
   --  included projects.
   --  Assumes that

   procedure Create_Temp_Dir;
   --  Creates the temporary directory and stores its name in Temp_Dir.

   procedure Brief_Help;
   --  Prints out the brief help.

   procedure Scan_Dir_Affix (Affix : String);
   --  Sets the values of Test_Dir_Prefix and Test_Dir_Suffix options.

   procedure Check_Subdir;
   --  Checks if there are no intersections between target and source dirs. If
   --  so, tries to create all target subdirs.

   procedure Check_Parallel;
   --  Checks if there are no intersections between target and source dirs. If
   --  so, tries to create all target parallel dirs.

   procedure Check_Separate_Root;
   --  Checks if there are no intersections between target and source dirs. If
   --  so, tries to create a directori hierarchy similar to one of the tested
   --  sources.

   function Is_Externally_Built (File : Virtual_File) return Boolean;
   --  Checks if the given source file belongs to an externally build library.

   procedure Create_Dirs (Target_Dirs : File_Array_Access);
   --  Creates given directories.

   function Non_Null_Intersection
     (Left  : File_Array_Access;
      Right : File_Array_Access)
      return Boolean;
   --  Returns True if two file arrays have at least one common file.

   function All_Source_Locations return File_Array_Access;
   --  Returns an array of all directories that may have source files.
   --  In case of project option, returns the list of recursively collected
   --  source dirs, otherwise collects the list from argument source files.

   --------------------------
   -- All_Source_Locations --
   --------------------------

   function All_Source_Locations return File_Array_Access is
      Source_Dirs : File_Array_Access := new File_Array'(Empty_File_Array);
      Tmp         : String_Access;
   begin
      if Source_Prj.all /= ("") then
         --  If we're here, than the project has been successfully loaded.

         Append
           (Source_Dirs,
            Source_Project_Tree.Root_Project.Source_Dirs (Recursive => True));
      else

         Reset_Location_Iterator;

         loop
            Tmp := new String'(Normalize_Pathname
              (Name           => Next_Source_Location,
               Case_Sensitive => False));
            exit when Tmp.all = "";

            Append (Source_Dirs, GNATCOLL.VFS.Create (+Tmp.all));
         end loop;

      end if;

      return Source_Dirs;
   end All_Source_Locations;

   ----------------
   -- Brief_Help --
   ----------------

   procedure Brief_Help is
   begin
      Put_Line ("usage: aunitstub [options] {filename} {-files filename} " &
                "[-cargs switches]");
      Put_Line ("");
      Put_Line ("Output options:");
      Put_Line (" --subdir=dirname        - " &
                "test files are put in the dirname subdirectories");
      Put_Line ("                           " &
                "located at the same level as near source files");
      Put_Line ("");
      Put_Line (" --separate-root=dirname - " &
                "test files are put in a same directory hierarchy");
      Put_Line ("                           " &
                "as the sources with dirname as the root directory");
      Put_Line ("");
      Put_Line (" --parallel=dirname      - " &
                "test files are put in dirname directory at the same");
      Put_Line ("                           " &
                "level as source files; dirname is prefix*suffix,");
      Put_Line ("                           " &
                "* is the name of the directory with source files");
      Put_Line ("");
      Put_Line ("Input options:");
      Put_Line ("");
      Put_Line (" --files=filename - " &
                "name of the text file containing a list of Ada source");
      Put_Line ("                    " &
                "files for which harness should be generated");
      Put_Line ("");
      Put_Line (" -Pprjname        - " &
                "name of project file to update compilation path.");
      Put_Line ("                    " &
                "if no sources are given in any other way, sources from");
      Put_Line ("                    prjname are considered as arguments");
   end Brief_Help;

   ----------------------
   -- Check_Parameters --
   ----------------------

   procedure Check_Parameters is

      Tmp          : String_Access;
      No_More_Args : Boolean := True;

      --  Project support:
      Files : File_Array_Access;
      Env   : Project_Environment_Access;

      procedure Update_Path_With_Project (Dirs : GNATCOLL.VFS.File_Array);
      --  Treats all the source dirs from project as -I option parameters.
      --  Also sets the value of Source_Dirs_Conflict flag.

      ------------------------------
      -- Update_Path_With_Project --
      ------------------------------

      procedure Update_Path_With_Project (Dirs : GNATCOLL.VFS.File_Array) is
      begin
         for F in Dirs'Range loop
            Store_I_Option (Dirs (F).Display_Full_Name);
         end loop;
      end Update_Path_With_Project;

   begin
      Initialize (Env);

      Run_Dir := new String'
        (Normalize_Pathname (Name => Get_Current_Dir,
                             Case_Sensitive => False));
      Create_Temp_Dir;

      if Source_Prj.all /= "" then
         if not Is_Regular_File (Source_Prj.all) then
            Report_Err ("aunitstub: project file " &
                        Source_Prj.all & " does not exist");
            raise Parameter_Error;
         end if;

         Tmp := new String'(Normalize_Pathname
           (Name           => Source_Prj.all,
            Case_Sensitive => False));
         Free (Source_Prj);
         Source_Prj := new String'(Tmp.all);
         Free (Tmp);

         Env.Set_Predefined_Project_Path (Detect_Predefined_Project_Path.all);

         Source_Project_Tree.Load (GNATCOLL.VFS.Create (+Source_Prj.all), Env);

         Update_Path_With_Project
           (Source_Project_Tree.Root_Project.Source_Dirs (Recursive => True));
      end if;

      Change_Dir (Temp_Dir.all);

      if SF_Table_Empty then
         if Source_Prj.all = "" then
            Report_Err ("No input source file set");
            Brief_Help;
            raise Parameter_Error;

         else
            Files :=
              Source_Project_Tree.Root_Project.Source_Files
                (Recursive => Recursive_Sources);

            for F in Files'Range loop
               if not Is_Externally_Built (Files (F)) then
                  Add_Source_To_Process (Files (F).Display_Full_Name,
                                         No_More_Args);
                  exit when No_More_Args;
               end if;
            end loop;

            --  If SF_Table is still empty, that means that the given project
            --  does not have any source files.
            if SF_Table_Empty then
               Report_Err (Source_Prj.all & " doesn't contain source files");
               Brief_Help;
               raise Parameter_Error;
            end if;
         end if;
      end if;

      case Output_M is
         when Subdir =>
            Check_Subdir;
         when Parallel =>
            Check_Parallel;
         when Separate_Root =>
            Check_Separate_Root;
      end case;

      Process_ADA_PRJ_INCLUDE_FILE;
      Store_I_Options;
      Set_Arg_List;
      Free (Env);
   end Check_Parameters;

   --------------------
   -- Check_Parallel --
   --------------------

   procedure Check_Parallel is
      Tmp             : String_Access;
      Base_Dir_Name   : String_Access;
      Target_Dir_Name : String_Access;

      Idx         : Integer;

      Future_Dirs : File_Array_Access := new File_Array'(Empty_File_Array);
      --  List of dirs to be generated. The list is checked for intersections
      --  with source dirs before any new directories are created.

   begin
      Reset_Location_Iterator;

      loop
         Tmp := new String'(Next_Source_Location);
         exit when Tmp.all = "";

         if Tmp.all (Tmp.all'Last) = Directory_Separator then
            Idx := Tmp.all'Last - 1;
         else
            Idx := Tmp.all'Last;
         end if;

         for I in reverse Tmp.all'First .. Idx loop
            if Tmp.all (I) = Directory_Separator then
               Base_Dir_Name := new String'(Tmp.all (Tmp.all'First .. I - 1));
               Target_Dir_Name := new String'(Tmp.all (I + 1 .. Tmp.all'Last));
               exit;
            end if;
         end loop;

         if Base_Dir_Name = null then
            Report_Err ("aunitstub: sources in root directory," &
                        " cannot make parallel dirs");
            raise Parameter_Error;
         end if;

         Append (Future_Dirs, GNATCOLL.VFS.Create
           (+(Base_Dir_Name.all   &
              Directory_Separator &
              Test_Dir_Prefix.all &
              Target_Dir_Name.all &
              Test_Dir_Suffix.all)));
      end loop;

      if Non_Null_Intersection (Future_Dirs, All_Source_Locations) then
         Report_Err ("aunitstub: invalid output directory, cannot mix up " &
                     "tests and infrastructure");
         raise Parameter_Error;
      end if;

      Create_Dirs (Future_Dirs);
      Set_Parallel_Output;
   end Check_Parallel;

   -------------------------
   -- Check_Separate_Root --
   -------------------------

   procedure Check_Separate_Root is
      Tmp, Buff    : String_Access;
      Maximin_Root : String_Access;
      Root_Length  : Integer;

      Future_Dirs : File_Array_Access := new File_Array'(Empty_File_Array);
      --  List of dirs to be generated. The list is checked for intersections
      --  with source dirs before any new directories are created.

      function Common_Root (Left : String; Right : String) return String;
      --  Returns the coincident beginning of both paths or an empty string.

      -------------------
      --  Common_Root  --
      -------------------

      function Common_Root (Left : String; Right : String) return String is
         Idxl : Integer := Left'First;
         Idxr : Integer := Right'First;

         Last_Dir_Sep_Index : Integer := Idxl - 1;
         --  We need to check for the following:
         --  ...somepath/dir/
         --  ...somepath/directory/

      begin
         if Left = "" or Right = "" then
            return "";
         end if;

         loop
            if Left (Idxl) = Directory_Separator
              and then Right (Idxr) = Directory_Separator
            then
               Last_Dir_Sep_Index := Idxl;
            end if;

            if Left (Idxl) /= Right (Idxr) then
               if Left (Idxl) = Directory_Separator
                 or else Right (Idxr) = Directory_Separator
               then
                  return Left (Left'First .. Last_Dir_Sep_Index);
               end if;

               return Left (Left'First .. Idxl - 1);
            end if;

            exit when Idxl = Left'Last or Idxr = Right'Last;

            Idxl := Idxl + 1;
            Idxr := Idxr + 1;
         end loop;

         return Left (Left'First .. Idxl);
      end Common_Root;

   begin
      Reset_Location_Iterator;
      Tmp := new String'(Next_Source_Location);
      Maximin_Root := new String'(Tmp.all);

      loop
         Tmp := new String'(Next_Source_Location);
         exit when Tmp.all = "";

         Buff := new String'(Common_Root (Tmp.all, Maximin_Root.all));

         if Buff.all = "" then
            Report_Err ("aunitstub: sources have different root dirs, " &
                        "cannot apply separate root output");
            raise Parameter_Error;
         end if;

         Free (Maximin_Root);
         Maximin_Root := new String'(Buff.all);
         Free (Buff);
         Free (Tmp);
      end loop;

      Root_Length := Maximin_Root.all'Length;

      Change_Dir (Run_Dir.all);

      Separate_Root_Dir := new String'
        (Normalize_Pathname (Name => Separate_Root_Dir.all,
                             Case_Sensitive => False));

      Reset_Location_Iterator;

      loop
         Tmp := new String'(Next_Source_Location);
         exit when Tmp.all = "";

         Append (Future_Dirs, GNATCOLL.VFS.Create
                 (+(Separate_Root_Dir.all & Directory_Separator &
                    Tmp.all (Root_Length + 1 .. Tmp.all'Last))));

         Free (Tmp);
      end loop;

      if Non_Null_Intersection (Future_Dirs, All_Source_Locations) then
         Report_Err ("aunitstub: invalid output directory, cannot mix up " &
                     "tests and infrastructure");
         raise Parameter_Error;
      end if;

      Create_Dirs (Future_Dirs);
      Set_Separate_Root (Maximin_Root.all);

      Change_Dir (Temp_Dir.all);
   end Check_Separate_Root;

   ------------------
   -- Check_Subdir --
   ------------------

   procedure Check_Subdir is
      Tmp : String_Access;

      Future_Dirs : File_Array_Access := new File_Array'(Empty_File_Array);
      --  List of dirs to be generated. The list is checked for intersections
      --  with source dirs before any new directories are created.
   begin
      Reset_Location_Iterator;

      loop
         Tmp := new String'(Next_Source_Location);
         exit when Tmp.all = "";

         Append (Future_Dirs, GNATCOLL.VFS.Create
                 (+(Tmp.all & Directory_Separator & Test_Subdir_Name.all)));
      end loop;

      if Non_Null_Intersection (Future_Dirs, All_Source_Locations) then
         Report_Err ("aunitstub: invalid output directory, cannot mix up " &
                     "tests and infrastructure");
         raise Parameter_Error;
      end if;

      Create_Dirs (Future_Dirs);
      Set_Subdir_Output;
   end Check_Subdir;

   --------------
   -- Clean_Up --
   --------------

   procedure Clean_Up is
   begin
      Context_Clean_Up;

      --  Cleaning up temporary dir

      if Temp_Dir /= null then
         if not Is_Directory (Temp_Dir.all) then
            --  We may be inside this temporary directory
            Change_Dir ("..");
         end if;

         begin
            Remove_Dir (Temp_Dir.all, Recursive => True);
         exception
            when Directory_Error =>
               Free (Temp_Dir);  -- to avoid cycling
               Report_Err ("aunitstub: cannot remove temporary directory");
               raise Fatal_Error;
         end;

         Free (Temp_Dir);
      end if;
   end Clean_Up;

   ----------------------
   -- Context_Clean_Up --
   ----------------------

   procedure Context_Clean_Up is
   begin
      if Is_Open (The_Context) then
         Close (The_Context);
      end if;

      if Has_Associations (The_Context) then
         Dissociate (The_Context);
      end if;
   end Context_Clean_Up;

   -----------------
   -- Create_Dirs --
   -----------------

   procedure Create_Dirs (Target_Dirs : File_Array_Access) is
      First : Integer;
   begin
      for J in Target_Dirs'Range loop
         declare
            Target_Dir : constant String :=
                           Target_Dirs.all (J).Display_Full_Name;
         begin
            First := Target_Dir'First;

            if Is_Regular_File (Target_Dir) then
               Report_Err ("aunitstub: cannot create dir " & Target_Dir);
               raise Parameter_Error;
            end if;

            for Idx in Target_Dir'Range loop
               if Target_Dir (Idx) = Directory_Separator
                 or else Idx = Target_Dir'Last
               then
                  if not Is_Directory (Target_Dir (First .. Idx)) then
                     begin
                        Make_Dir (Target_Dir (First .. Idx));
                     exception
                        when Directory_Error =>
                           Report_Err ("aunitstub: cannot create dir " &
                                       Target_Dir (First .. Idx));
                           raise Parameter_Error;
                     end;
                  end if;
               end if;
            end loop;
         end;
      end loop;
   end Create_Dirs;

   ---------------------
   -- Create_Temp_Dir --
   ---------------------

   procedure Create_Temp_Dir is
      FD        : File_Descriptor;
      Temp_Name : Temp_File_Name;
      Success   : Boolean;

   begin
      --  Here we use exactly the same approach as in gnatelim

      --  ??? We create the temp dir by first creating the temp file, then
      --  closing and deleting it, then creating a dir with the same name.
      --  This is not atomary as another program can sneak in between file
      --  deletion and dir creation and snatch this name for itself. This is
      --  quite unlikely and anyway we don't have any other system-independent
      --  way at the moment
      Create_Temp_File (FD, Temp_Name);
      Close (FD);
      Delete_File (Temp_Name, Success);

      if not Success then
         Report_Err ("aunitstub: cannot delete the temporary file that was "
                     & "just created");

         raise Fatal_Error;
      end if;

      Make_Dir (Temp_Name);

      Temp_Dir :=
        new String'(Temp_Name (Temp_Name'First .. Temp_Name'Last - 1));

   exception
      when Directory_Error =>
         Report_Err ("aunitstub: cannot create the temporary directory");
         raise Fatal_Error;
   end Create_Temp_Dir;

   ------------------------------------
   -- Detect_Predefined_Project_Path --
   ------------------------------------

   function Detect_Predefined_Project_Path return File_Array_Access is
      FD        : File_Descriptor;
      Temp_Name : String_Access;

      Tmp_File : File_Type;
      Tmp_Str  : String_Access;

      Exit_Code  : Integer;
      Suffix_Pos : Integer;
      First_Idx  : Integer;
      Prefix     : String_Access;

      Project_Path_Heading : constant String := "Project Search Path:";

      Collect_Dirs   : Boolean := False;
      Spawns_Success : Boolean;

      Project_Dirs : File_Array_Access := new File_Array'(Empty_File_Array);

      Gnatls    : constant String               := "gnatls";
      Arg_List  : constant Argument_List_Access :=
                    Argument_String_To_List ("-v");

   begin
      if ASIS_UL.Common.Gcc_To_Call = null then
         Prefix := new String'("");

      else
         Suffix_Pos := ASIS_UL.Common.Gcc_To_Call.all'Last;
         First_Idx  := ASIS_UL.Common.Gcc_To_Call.all'First;

         loop
            if ASIS_UL.Common.Gcc_To_Call.all
              (Suffix_Pos - 2 .. Suffix_Pos) = "gcc"
            then
               Prefix := new String'
                 (ASIS_UL.Common.Gcc_To_Call.all
                    (First_Idx .. Suffix_Pos - 3));
               exit;
            end if;

            Suffix_Pos := Suffix_Pos - 1;
         end loop;
      end if;

      Create_Temp_Output_File (FD, Temp_Name);

      Spawn
        (Program_Name => Prefix.all & Gnatls,
         Args         => Arg_List.all,
         Output_File  => Temp_Name.all,
         Success      => Spawns_Success,
         Return_Code  => Exit_Code,
         Err_To_Out   => False);

      Close (FD);

      if not Spawns_Success then
         return Project_Dirs;
      end if;

      Open (Tmp_File, In_File, Temp_Name.all);

      while not End_Of_File (Tmp_File) loop
         Tmp_Str := new String'(Trim (Get_Line (Tmp_File), Both));

         if Collect_Dirs then
            Append (Project_Dirs, GNATCOLL.VFS.Create (+Tmp_Str.all));
         end if;

         if Tmp_Str.all = Project_Path_Heading then
            Free (Tmp_Str);
            Tmp_Str := new String'(Get_Line (Tmp_File));
            --  Getting rid of "<Current_Directory>"

            Collect_Dirs := True;
         end if;

         Free (Tmp_Str);
      end loop;

      Delete (Tmp_File);
      return Project_Dirs;

   exception
         when others =>
         Report_Err ("aunitstub: detecting predefined project path failed");
         --  Exception info will be generated in main driver
         raise;
   end Detect_Predefined_Project_Path;

   -------------------------
   -- Is_Externally_Built --
   -------------------------
   function Is_Externally_Built (File : Virtual_File) return Boolean is
      F_Info : constant File_Info    := Info (Source_Project_Tree, File);
      Proj   : constant Project_Type := Project (F_Info);
      Attr   : constant Attribute_Pkg_String := Build ("", "externally_built");
   begin
      if Has_Attribute (Proj, Attr) then
         if Attribute_Value (Proj, Attr) = "true" then
            return True;
         end if;
      end if;
      return False;
   end Is_Externally_Built;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      Scan_Parameters;
      Check_Parameters;

   exception
      when Parameter_Error =>
         --  The diagnosis is already generated
         raise Fatal_Error;
      when others =>
         Report_Err ("aunitstub: initialization failed");
         --  Exception info will be generated in main driver
         raise;
   end Initialize;

   ---------------------------
   -- Non_Null_Intersection --
   ---------------------------

   function Non_Null_Intersection
     (Left  : File_Array_Access;
      Right : File_Array_Access) return Boolean is
   begin
      for J in Left'Range loop
         declare
            Left_Str : constant String :=
                         Normalize_Pathname
                           (Name => Left.all (J).Display_Full_Name,
                            Case_Sensitive => False);
         begin
            for K in Right'Range loop
               if Left_Str =
                 Normalize_Pathname
                   (Name => Right.all (K).Display_Full_Name,
                    Case_Sensitive => False)
               then
                  return True;
               end if;
            end loop;
         end;
      end loop;

      return False;
   end Non_Null_Intersection;

   -------------------------
   -- Read_Args_From_File --
   -------------------------

   procedure Read_Args_From_File (Par_File_Name : String) is

      No_More_Args     : Boolean := False;
      Arg_File         : File_Type;
      File_Name_Buffer : String (1 .. 16 * 1024);
      File_Name_Len    : Natural := 0;
      Next_Ch          : Character;
      End_Of_Line      : Boolean;

      function Get_File_Name return String;
      --  Reads from Par_File_Name the name of the next file (the file to read
      --  from should exist and be opened). Returns an empty string if there is
      --  no file names in Par_File_Name any more

      -------------------
      -- Get_File_Name --
      -------------------

      function Get_File_Name return String is
      begin
         File_Name_Len := 0;

         if not End_Of_File (Arg_File) then
            Get (Arg_File, Next_Ch);

            while Next_Ch = ' ' loop
               exit when End_Of_File (Arg_File);
               Get (Arg_File, Next_Ch);
            end loop;

            while Next_Ch /= ' ' loop
               File_Name_Len := File_Name_Len + 1;
               File_Name_Buffer (File_Name_Len) := Next_Ch;

               Look_Ahead (Arg_File, Next_Ch, End_Of_Line);

               exit when End_Of_Line or else End_Of_File (Arg_File);

               Get (Arg_File, Next_Ch);
            end loop;
         end if;

         return File_Name_Buffer (1 .. File_Name_Len);
      end Get_File_Name;

   begin
      if not Is_Regular_File (Par_File_Name) then
         Report_Err ("aunitstub: " & Par_File_Name & " does not exist");
         return;
      end if;

      Open (Arg_File, In_File, Par_File_Name);

      loop
         Add_Source_To_Process (Get_File_Name, No_More_Args);
         exit when No_More_Args;
      end loop;

      Close (Arg_File);

   exception
      when others =>
         Report_Err ("aunitstub: cannot read arguments from " & Par_File_Name);
         --  Exception info will be generated in main driver
         raise;
   end Read_Args_From_File;

   --------------------
   -- Scan_Dir_Affix --
   --------------------

   procedure Scan_Dir_Affix (Affix : String) is
      First_Idx : constant Integer := Affix'First;
      Last_Idx  : constant Integer := Affix'Last;
   begin
      for Idx in First_Idx .. Last_Idx loop
         if Affix (Idx) = '*' then
            Free (Test_Dir_Prefix);
            Test_Dir_Prefix := new String'(Affix (First_Idx .. Idx - 1));
            Free (Test_Dir_Suffix);
            Test_Dir_Suffix := new String'(Affix (Idx + 1 .. Last_Idx));
            return;
         end if;
      end loop;

      Report_Err ("aunitstub: invalid parallel dir affix, should contain *");
      raise Parameter_Error;
   end Scan_Dir_Affix;

   ---------------------
   -- Scan_Parameters --
   ---------------------

   procedure Scan_Parameters is
      No_More_Args    : Boolean;
      Multiple_Output : Boolean := False;
   begin
      Initialize_Option_Scan
        (Stop_At_First_Non_Switch => True,
         Section_Delimiters       => "cargs");

      loop
         case GNAT.Command_Line.Getopt
           ("-files= h d? P? q -separate-root= " &
            "-parallel= -subdir= -testcase r")
         is
            when ASCII.NUL =>
               exit;

            when 'd' =>
               if Full_Switch = "d" then
                  Set_Debug_Options (Parameter);
               end if;

            when 'P' =>
               Source_Prj := new String'(Parameter);

            when 'q' =>
               Quiet := True;

            when 'r' =>
               Recursive_Sources := True;

            when '-' =>
               if Full_Switch = "-files" then
                  Read_Args_From_File (Parameter);
               end if;

               if Full_Switch = "-separate-root" then
                  if not Multiple_Output then
                     Output_M := Separate_Root;
                     Separate_Root_Dir := new String'(Parameter);
                     Multiple_Output := True;
                  else
                     Report_Err
                       ("aunitstub: multiple output modes are not allowed");
                     raise Parameter_Error;
                  end if;
               end if;

               if Full_Switch = "-parallel" then
                  if not Multiple_Output then
                     Output_M := Parallel;
                     Scan_Dir_Affix (Parameter);
                     Multiple_Output := True;
                  else
                     Report_Err
                       ("aunitstub: multiple output modes are not allowed");
                     raise Parameter_Error;
                  end if;
               end if;

               if Full_Switch = "-subdir" then

                  if not Multiple_Output then
                     Output_M := Subdir;
                     Test_Subdir_Name := new String'(Parameter);
                     Multiple_Output := True;
                  else
                     Report_Err
                       ("aunitstub: multiple output modes are not allowed");
                     raise Parameter_Error;
                  end if;

               end if;

               --  switch for hi-lite specific code generation
               if Full_Switch = "-testcase" then
                  Test_Case := True;
               end if;

            when others =>
               Brief_Help;
               raise Parameter_Error;
         end case;
      end loop;

      loop
         Add_Source_To_Process (Get_Argument, No_More_Args);
         exit when No_More_Args;
      end loop;

      Process_cargs_Section;

   exception
      when GNAT.Command_Line.Invalid_Switch =>
         Report_Err ("aunitstub: invalid switch : " & Full_Switch);
         Brief_Help;

         raise Parameter_Error;

      when GNAT.Command_Line.Invalid_Parameter =>
         Report_Err ("aunitstub: missing parameter for: -" & Full_Switch);
         Brief_Help;

         raise Parameter_Error;
   end Scan_Parameters;

end AUnitStub.Environment;
