------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P R J . M A K R                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2001-2003 Free Software Foundation, Inc.          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Csets;
with Namet;    use Namet;
with Opt;
with Output;
with Osint;    use Osint;
with Prj;      use Prj;
with Prj.Com;
with Prj.Part;
with Prj.PP;
with Prj.Tree; use Prj.Tree;
with Snames;   use Snames;
with Table;    use Table;

with Ada.Characters.Handling;   use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Expect;               use GNAT.Expect;
with GNAT.OS_Lib;               use GNAT.OS_Lib;
with GNAT.Regexp;               use GNAT.Regexp;
with GNAT.Regpat;               use GNAT.Regpat;

package body Prj.Makr is

   Non_Empty_Node : constant Project_Node_Id := 1;
   --  Used for the With_Clause of the naming project

   type Matched_Type is (True, False, Excluded);

   Naming_File_Suffix      : constant String := "_naming";
   Source_List_File_Suffix : constant String := "_source_list.txt";

   Output_FD   : File_Descriptor;
   --  To save the project file and its naming project file.

   procedure Write_Eol;
   --  Output an empty line.

   procedure Write_A_Char (C : Character);
   --  Write one character to Output_FD

   procedure Write_A_String (S : String);
   --  Write a String to Output_FD

   package Processed_Directories is new Table.Table
     (Table_Component_Type => String_Access,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 0,
      Table_Initial        => 10,
      Table_Increment      => 10,
      Table_Name           => "Prj.Makr.Processed_Directories");

   ----------
   -- Make --
   ----------

   procedure Make
     (File_Path         : String;
      Project_File      : Boolean;
      Directories       : Argument_List;
      Name_Patterns     : Argument_List;
      Excluded_Patterns : Argument_List;
      Foreign_Patterns  : Argument_List;
      Preproc_Switches  : Argument_List;
      Very_Verbose      : Boolean)
   is
      Path_Name : String (1 .. File_Path'Length +
                            Project_File_Extension'Length);
      Path_Last : Natural := File_Path'Length;

      Directory_Last    : Natural := 0;

      Output_Name      : String (Path_Name'Range);
      Output_Name_Last : Natural;
      Output_Name_Id   : Name_Id;

      Project_Node        : Project_Node_Id := Empty_Node;
      Project_Declaration : Project_Node_Id := Empty_Node;
      Source_Dirs_List    : Project_Node_Id := Empty_Node;
      Current_Source_Dir  : Project_Node_Id := Empty_Node;

      Project_Naming_Node : Project_Node_Id := Empty_Node;
      Project_Naming_Decl : Project_Node_Id := Empty_Node;
      Naming_Package      : Project_Node_Id := Empty_Node;

      Project_Naming_File_Name : String (1 .. Output_Name'Length +
                                           Naming_File_Suffix'Length);

      Project_Naming_Last : Natural;
      Project_Naming_Id   : Name_Id := No_Name;

      Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp;
      Regular_Expressions  : array (Name_Patterns'Range) of Regexp;
      Foreign_Expressions  : array (Foreign_Patterns'Range) of Regexp;

      Source_List_Path : String (1 .. Output_Name'Length +
                                   Source_List_File_Suffix'Length);
      Source_List_Last : Natural;

      Source_List_FD : File_Descriptor;

      Matcher : constant Pattern_Matcher :=
                  Compile (Expression => "expected|Unit.*\)|No such");

      Args : Argument_List  (1 .. Preproc_Switches'Length + 6);
--                 (1 => new String'("-c"),
--                  2 => new String'("-gnats"),
--                  3 => new String'("-gnatu"),
--                  4 => new String'("-x"),
--                  5 => new String'("ada"),
--                  6 => null);

      type SFN_Pragma is record
         Unit : String_Access;
         File : String_Access;
         Spec : Boolean;
      end record;

      package SFN_Pragmas is new Table.Table
        (Table_Component_Type => SFN_Pragma,
         Table_Index_Type     => Natural,
         Table_Low_Bound      => 0,
         Table_Initial        => 50,
         Table_Increment      => 50,
         Table_Name           => "Prj.Makr.SFN_Pragmas");

      procedure Process_Directory (Dir_Name : String; Recursively : Boolean);
      --  Look for Ada and foreign sources in a directory, according to the
      --  patterns. When Recursively is True, after looking for sources in
      --  Dir_Name, look also in its subdirectories, if any.

      -----------------------
      -- Process_Directory --
      -----------------------

      procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
         Matched  : Matched_Type := False;
         Str      : String (1 .. 2_000);
         Last     : Natural;
         Dir      : Dir_Type;
         Process  : Boolean := True;

      begin
         if Opt.Verbose_Mode then
            Output.Write_Str ("Processing directory """);
            Output.Write_Str (Dir_Name);
            Output.Write_Line ("""");
         end if;

         --  Avoid processing several times the same directory.

         for Index in 1 .. Processed_Directories.Last loop
            if Processed_Directories.Table (Index).all = Dir_Name then
               Process := False;
               exit;
            end if;
         end loop;

         if Process then
            Processed_Directories. Increment_Last;
            Processed_Directories.Table (Processed_Directories.Last) :=
              new String'(Dir_Name);
            --  Get the source file names from the directory.
            --  Fails if the directory does not exist.

            begin
               Open (Dir, Dir_Name);

            exception
               when Directory_Error =>
                  Prj.Com.Fail ("cannot open directory """, Dir_Name, """");
            end;

            --  Process each regular file in the directory

            loop
               Read (Dir, Str, Last);
               exit when Last = 0;

               if Is_Regular_File
                 (Dir_Name & Directory_Separator & Str (1 .. Last))
               then
                  Matched := True;

                  --  First, check if the file name matches at least one of
                  --  the excluded expressions;

                  for Index in Excluded_Expressions'Range loop
                     if
                       Match (Str (1 .. Last), Excluded_Expressions (Index))
                     then
                        Matched := Excluded;
                        exit;
                     end if;
                  end loop;

                  --  If it does not match any of the excluded expressions,
                  --  check if the file name matches at least one of the
                  --  regular expressions.

                  if Matched = True then
                     Matched := False;

                     for Index in Regular_Expressions'Range loop
                        if
                          Match (Str (1 .. Last), Regular_Expressions (Index))
                        then
                           Matched := True;
                           exit;
                        end if;
                     end loop;
                  end if;

                  if Very_Verbose
                    or else (Matched = True and then Opt.Verbose_Mode)
                  then
                     Output.Write_Str ("   Checking """);
                     Output.Write_Str (Str (1 .. Last));
                     Output.Write_Str (""": ");
                  end if;

                  --  If the file name matches one of the regular expressions,
                  --  parse it to get its unit name.

                  if Matched = True then
                     declare
                        PD     : Process_Descriptor;
                        Result : Expect_Match;

                     begin
                        Args (Args'Last) := new String'
                                                  (Dir_Name &
                                                   Directory_Separator &
                                                   Str (1 .. Last));

                        begin
                           Non_Blocking_Spawn
                             (PD, "gcc", Args, Err_To_Out => True);
                           Expect (PD, Result, Matcher);

                        exception
                           when Process_Died =>
                              if Opt.Verbose_Mode then
                                 Output.Write_Str ("(process died) ");
                              end if;

                              Result := Expect_Timeout;
                        end;

                        if Result /= Expect_Timeout then

                           --  If we got a unit name, this is a valid source
                           --  file.

                           declare
                              S : constant String := Expect_Out_Match (PD);

                           begin
                              if S'Length >= 13
                                and then S (S'First .. S'First + 3) = "Unit"
                              then
                                 if Opt.Verbose_Mode then
                                    Output.Write_Str
                                      (S (S'Last - 4 .. S'Last - 1));
                                    Output.Write_Str (" of ");
                                    Output.Write_Line
                                      (S (S'First + 5 .. S'Last - 7));
                                 end if;

                                 if Project_File then

                                    --  Add the corresponding attribute in the
                                    --  Naming package of the naming project.

                                    declare
                                       Decl_Item : constant Project_Node_Id :=
                                         Default_Project_Node
                                         (Of_Kind =>
                                            N_Declarative_Item);

                                       Attribute : constant Project_Node_Id :=
                                         Default_Project_Node
                                         (Of_Kind =>
                                            N_Attribute_Declaration);

                                       Expression : constant Project_Node_Id :=
                                         Default_Project_Node
                                         (Of_Kind => N_Expression,
                                          And_Expr_Kind => Single);

                                       Term : constant Project_Node_Id :=
                                         Default_Project_Node
                                         (Of_Kind => N_Term,
                                          And_Expr_Kind => Single);

                                       Value : constant Project_Node_Id :=
                                         Default_Project_Node
                                         (Of_Kind => N_Literal_String,
                                          And_Expr_Kind => Single);

                                    begin
                                       Set_Next_Declarative_Item
                                         (Decl_Item,
                                          To => First_Declarative_Item_Of
                                            (Naming_Package));
                                       Set_First_Declarative_Item_Of
                                         (Naming_Package, To => Decl_Item);
                                       Set_Current_Item_Node
                                         (Decl_Item, To => Attribute);

                                       if
                                         S (S'Last - 5 .. S'Last) = "(spec)"
                                       then
                                          Set_Name_Of
                                            (Attribute, To => Name_Spec);
                                       else
                                          Set_Name_Of
                                            (Attribute,
                                             To => Name_Body);
                                       end if;

                                       Name_Len := S'Last - S'First - 11;
                                       Name_Buffer (1 .. Name_Len) :=
                                         (To_Lower
                                            (S (S'First + 5 .. S'Last - 7)));
                                       Set_Associative_Array_Index_Of
                                         (Attribute, To => Name_Find);

                                       Set_Expression_Of
                                         (Attribute, To => Expression);
                                       Set_First_Term (Expression, To => Term);
                                       Set_Current_Term (Term, To => Value);

                                       Name_Len := Last;
                                       Name_Buffer (1 .. Name_Len) :=
                                         Str (1 .. Last);
                                       Set_String_Value_Of
                                         (Value, To => Name_Find);
                                    end;

                                    --  Add source file name to source list
                                    --  file.

                                    Last := Last + 1;
                                    Str (Last) := ASCII.LF;

                                    if Write (Source_List_FD,
                                              Str (1)'Address,
                                              Last) /= Last
                                    then
                                       Prj.Com.Fail ("disk full");
                                    end if;
                                 else
                                    --  Add an entry in the SFN_Pragmas table

                                    SFN_Pragmas.Increment_Last;
                                    SFN_Pragmas.Table (SFN_Pragmas.Last) :=
                                      (Unit => new String'
                                         (S (S'First + 5 .. S'Last - 7)),
                                       File => new String'(Str (1 .. Last)),
                                       Spec => S (S'Last - 5 .. S'Last)
                                       = "(spec)");
                                 end if;

                              else
                                 if Opt.Verbose_Mode then
                                    Output.Write_Line ("not a unit");
                                 end if;
                              end if;
                           end;

                        else
                           if Opt.Verbose_Mode then
                              Output.Write_Line ("not a unit");
                           end if;
                        end if;

                        Close (PD);
                     end;

                  else
                     if Matched = False then
                        --  Look if this is a foreign source

                        for Index in Foreign_Expressions'Range loop
                           if Match (Str (1 .. Last),
                                     Foreign_Expressions (Index))
                           then
                              Matched := True;
                              exit;
                           end if;
                        end loop;
                     end if;

                     if Very_Verbose then
                        case Matched is
                           when False =>
                              Output.Write_Line ("no match");

                           when Excluded =>
                              Output.Write_Line ("excluded");

                           when True =>
                              Output.Write_Line ("foreign source");
                        end case;
                     end if;

                     if Project_File and Matched = True then

                        --  Add source file name to source list file

                        Last := Last + 1;
                        Str (Last) := ASCII.LF;

                        if Write (Source_List_FD,
                                  Str (1)'Address,
                                  Last) /= Last
                        then
                           Prj.Com.Fail ("disk full");
                        end if;
                     end if;
                  end if;
               end if;
            end loop;

            Close (Dir);
         end if;

         --  If Recursively is True, call itself for each subdirectory.
         --  We do that, even when this directory has already been processed,
         --  because all of its subdirectories may not have been processed.

         if Recursively then
            Open (Dir, Dir_Name);

            loop
               Read (Dir, Str, Last);
               exit when Last = 0;

               --  Do not call itself for "." or ".."

               if Is_Directory
                 (Dir_Name & Directory_Separator & Str (1 .. Last))
                 and then Str (1 .. Last) /= "."
                 and then Str (1 .. Last) /= ".."
               then
                  Process_Directory
                    (Dir_Name & Directory_Separator & Str (1 .. Last),
                     Recursively => True);
               end if;
            end loop;

            Close (Dir);
         end if;
      end Process_Directory;

   --  Start of processing for Make

   begin
      --  Do some needed initializations

      Csets.Initialize;
      Namet.Initialize;
      Snames.Initialize;
      Prj.Initialize;

      SFN_Pragmas.Set_Last (0);

      Processed_Directories.Set_Last (0);

      --  Initialize the compiler switches

      Args (1) := new String'("-c");
      Args (2) := new String'("-gnats");
      Args (3) := new String'("-gnatu");
      Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches;
      Args (4 + Preproc_Switches'Length) := new String'("-x");
      Args (5 + Preproc_Switches'Length) := new String'("ada");

      --  Get the path and file names

      if File_Names_Case_Sensitive then
         Path_Name (1 .. Path_Last) := File_Path;
      else
         Path_Name (1 .. Path_Last) := To_Lower (File_Path);
      end if;

      Path_Name (Path_Last + 1 .. Path_Name'Last) :=
        Project_File_Extension;

      --  Get the end of directory information, if any

      for Index in reverse 1 .. Path_Last loop
         if Path_Name (Index) = Directory_Separator then
            Directory_Last := Index;
            exit;
         end if;
      end loop;

      if Project_File then
         if Path_Last < Project_File_Extension'Length + 1
           or else Path_Name
           (Path_Last - Project_File_Extension'Length + 1 .. Path_Last)
           /= Project_File_Extension
         then
            Path_Last := Path_Name'Last;
         end if;

         Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last));
         Output_Name_Last := Path_Last - Project_File_Extension'Length;

         if Directory_Last /= 0 then
            Output_Name (1 .. Output_Name_Last - Directory_Last) :=
              Output_Name (Directory_Last + 1 .. Output_Name_Last);
            Output_Name_Last := Output_Name_Last - Directory_Last;
         end if;

         --  Get the project name id

         Name_Len := Output_Name_Last;
         Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len);
         Output_Name_Id := Name_Find;

         --  Create the project naming file name

         Project_Naming_Last := Output_Name_Last;
         Project_Naming_File_Name (1 .. Project_Naming_Last) :=
           Output_Name (1 .. Project_Naming_Last);
         Project_Naming_File_Name
           (Project_Naming_Last + 1 ..
              Project_Naming_Last + Naming_File_Suffix'Length) :=
           Naming_File_Suffix;
         Project_Naming_Last :=
           Project_Naming_Last + Naming_File_Suffix'Length;

         --  Get the project naming id

         Name_Len := Project_Naming_Last;
         Name_Buffer (1 .. Name_Len) :=
           Project_Naming_File_Name (1 .. Name_Len);
         Project_Naming_Id := Name_Find;

         Project_Naming_File_Name
           (Project_Naming_Last + 1 ..
              Project_Naming_Last + Project_File_Extension'Length) :=
           Project_File_Extension;
         Project_Naming_Last :=
           Project_Naming_Last + Project_File_Extension'Length;

         --  Create the source list file name

         Source_List_Last := Output_Name_Last;
         Source_List_Path (1 .. Source_List_Last) :=
           Output_Name (1 .. Source_List_Last);
         Source_List_Path
           (Source_List_Last + 1 ..
              Source_List_Last + Source_List_File_Suffix'Length) :=
           Source_List_File_Suffix;
         Source_List_Last := Source_List_Last + Source_List_File_Suffix'Length;

         --  Add the project file extension to the project name

         Output_Name
           (Output_Name_Last + 1 ..
              Output_Name_Last + Project_File_Extension'Length) :=
           Project_File_Extension;
         Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
      end if;

      --  Change the current directory to the directory of the project file,
      --  if any directory information is specified.

      if Directory_Last /= 0 then
         begin
            Change_Dir (Path_Name (1 .. Directory_Last));
         exception
            when Directory_Error =>
               Prj.Com.Fail
                 ("unknown directory """,
                  Path_Name (1 .. Directory_Last),
                  """");
         end;
      end if;

      if Project_File then

         --  Delete the source list file, if it already exists

         declare
            Discard : Boolean;

         begin
            Delete_File
              (Source_List_Path (1 .. Source_List_Last),
               Success => Discard);
         end;

         --  And create a new source list file.
         --  Fail if file cannot be created.

         Source_List_FD := Create_New_File
           (Name  => Source_List_Path (1 .. Source_List_Last),
            Fmode => Text);

         if Source_List_FD = Invalid_FD then
            Prj.Com.Fail
              ("cannot create file """,
               Source_List_Path (1 .. Source_List_Last),
               """");
         end if;
      end if;

      --  Compile the regular expressions. Fails immediately if any of
      --  the specified strings is in error.

      for Index in Excluded_Expressions'Range loop
         if Very_Verbose then
            Output.Write_Str ("Excluded pattern: """);
            Output.Write_Str (Excluded_Patterns (Index).all);
            Output.Write_Line ("""");
         end if;

         begin
            Excluded_Expressions (Index) :=
              Compile (Pattern => Excluded_Patterns (Index).all, Glob => True);

         exception
            when Error_In_Regexp =>
               Prj.Com.Fail
                 ("invalid regular expression """,
                  Excluded_Patterns (Index).all,
                  """");
         end;
      end loop;

      for Index in Foreign_Expressions'Range loop
         if Very_Verbose then
            Output.Write_Str ("Foreign pattern: """);
            Output.Write_Str (Foreign_Patterns (Index).all);
            Output.Write_Line ("""");
         end if;

         begin
            Foreign_Expressions (Index) :=
              Compile (Pattern => Foreign_Patterns (Index).all, Glob => True);

         exception
            when Error_In_Regexp =>
               Prj.Com.Fail
                 ("invalid regular expression """,
                  Foreign_Patterns (Index).all,
                  """");
         end;
      end loop;

      for Index in Regular_Expressions'Range loop
         if Very_Verbose then
            Output.Write_Str ("Pattern: """);
            Output.Write_Str (Name_Patterns (Index).all);
            Output.Write_Line ("""");
         end if;

         begin
            Regular_Expressions (Index) :=
              Compile (Pattern => Name_Patterns (Index).all, Glob => True);

         exception
            when Error_In_Regexp =>
               Prj.Com.Fail
                 ("invalid regular expression """,
                  Name_Patterns (Index).all,
                  """");
         end;
      end loop;

      if Project_File then
         if Opt.Verbose_Mode then
            Output.Write_Str ("Naming project file name is """);
            Output.Write_Str
              (Project_Naming_File_Name (1 .. Project_Naming_Last));
            Output.Write_Line ("""");
         end if;

         --  If there is already a project file with the specified name,
         --  parse it to get the components that are not automatically
         --  generated.

         if Is_Regular_File (Output_Name (1 .. Output_Name_Last)) then
            if Opt.Verbose_Mode then
               Output.Write_Str ("Parsing already existing project file """);
               Output.Write_Str (Output_Name (1 .. Output_Name_Last));
               Output.Write_Line ("""");
            end if;

            Part.Parse
              (Project           => Project_Node,
               Project_File_Name => Output_Name (1 .. Output_Name_Last),
               Always_Errout_Finalize => False);

            --  If parsing was successful, remove the components that are
            --  automatically generated, if any, so that they will be
            --  unconditionally added later.

            if Project_Node /= Empty_Node then

               --  Remove the with clause for the naming project file

               declare
                  With_Clause : Project_Node_Id :=
                    First_With_Clause_Of (Project_Node);
                  Previous    : Project_Node_Id := Empty_Node;

               begin
                  while With_Clause /= Empty_Node loop
                     if Tree.Name_Of (With_Clause) = Project_Naming_Id then
                        if Previous = Empty_Node then
                           Set_First_With_Clause_Of
                             (Project_Node,
                              To => Next_With_Clause_Of (With_Clause));
                        else
                           Set_Next_With_Clause_Of
                             (Previous,
                              To => Next_With_Clause_Of (With_Clause));
                        end if;

                        exit;
                     end if;

                     Previous := With_Clause;
                     With_Clause := Next_With_Clause_Of (With_Clause);
                  end loop;
               end;

               --  Remove attribute declarations of Source_Files,
               --  Source_List_File, Source_Dirs, and the declaration of
               --  package Naming, if they exist.

               declare
                  Declaration  : Project_Node_Id :=
                                   First_Declarative_Item_Of
                                     (Project_Declaration_Of
                                       (Project_Node));
                  Previous     : Project_Node_Id := Empty_Node;
                  Current_Node : Project_Node_Id := Empty_Node;

               begin
                  while Declaration /= Empty_Node loop
                     Current_Node := Current_Item_Node (Declaration);

                     if (Kind_Of (Current_Node) = N_Attribute_Declaration
                           and then
                           (Tree.Name_Of (Current_Node) = Name_Source_Files
                             or else Tree.Name_Of (Current_Node) =
                                               Name_Source_List_File
                              or else Tree.Name_Of (Current_Node) =
                              Name_Source_Dirs))
                       or else
                       (Kind_Of (Current_Node) = N_Package_Declaration
                          and then Tree.Name_Of (Current_Node) = Name_Naming)
                     then
                        if Previous = Empty_Node then
                           Set_First_Declarative_Item_Of
                             (Project_Declaration_Of (Project_Node),
                              To => Next_Declarative_Item (Declaration));

                        else
                           Set_Next_Declarative_Item
                             (Previous,
                              To => Next_Declarative_Item (Declaration));
                        end if;

                     else
                        Previous := Declaration;
                     end if;

                     Declaration := Next_Declarative_Item (Declaration);
                  end loop;
               end;
            end if;
         end if;

         --  If there were no already existing project file, or if the parsing
         --  was unsuccessful, create an empty project node with the correct
         --  name and its project declaration node.

         if Project_Node = Empty_Node then
            Project_Node := Default_Project_Node (Of_Kind => N_Project);
            Set_Name_Of (Project_Node, To => Output_Name_Id);
            Set_Project_Declaration_Of
              (Project_Node,
               To => Default_Project_Node (Of_Kind => N_Project_Declaration));

         end if;

         --  Create the naming project node, and add an attribute declaration
         --  for Source_Files as an empty list, to indicate there are no
         --  sources in the naming project.

         Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project);
         Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id);
         Project_Naming_Decl :=
           Default_Project_Node (Of_Kind => N_Project_Declaration);
         Set_Project_Declaration_Of (Project_Naming_Node, Project_Naming_Decl);
         Naming_Package :=
           Default_Project_Node (Of_Kind => N_Package_Declaration);
         Set_Name_Of (Naming_Package, To => Name_Naming);

         declare
            Decl_Item : constant Project_Node_Id :=
              Default_Project_Node (Of_Kind => N_Declarative_Item);

            Attribute : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Attribute_Declaration,
               And_Expr_Kind => List);

            Expression : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Expression,
               And_Expr_Kind => List);

            Term  : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Term,
               And_Expr_Kind => List);

            Empty_List : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Literal_String_List);

         begin
            Set_First_Declarative_Item_Of
              (Project_Naming_Decl, To => Decl_Item);
            Set_Next_Declarative_Item (Decl_Item, Naming_Package);
            Set_Current_Item_Node (Decl_Item, To => Attribute);
            Set_Name_Of (Attribute, To => Name_Source_Files);
            Set_Expression_Of (Attribute, To => Expression);
            Set_First_Term (Expression, To => Term);
            Set_Current_Term (Term, To => Empty_List);
         end;

         --  Add a with clause on the naming project in the main project

         declare
            With_Clause : constant Project_Node_Id :=
              Default_Project_Node (Of_Kind => N_With_Clause);

         begin
            Set_Next_With_Clause_Of
              (With_Clause, To => First_With_Clause_Of (Project_Node));
            Set_First_With_Clause_Of (Project_Node, To => With_Clause);
            Set_Name_Of (With_Clause, To => Project_Naming_Id);

            --  We set the project node to something different than
            --  Empty_Node, so that Prj.PP does not generate a limited
            --  with clause.

            Set_Project_Node_Of (With_Clause, Non_Empty_Node);

            Name_Len := Project_Naming_Last;
            Name_Buffer (1 .. Name_Len) :=
              Project_Naming_File_Name (1 .. Project_Naming_Last);
            Set_String_Value_Of (With_Clause, To => Name_Find);
         end;

         Project_Declaration := Project_Declaration_Of (Project_Node);

         --  Add a renaming declaration for package Naming in the main project

         declare
            Decl_Item  : constant Project_Node_Id :=
              Default_Project_Node (Of_Kind => N_Declarative_Item);

            Naming : constant Project_Node_Id :=
              Default_Project_Node (Of_Kind => N_Package_Declaration);
         begin
            Set_Next_Declarative_Item
              (Decl_Item,
               To => First_Declarative_Item_Of (Project_Declaration));
            Set_First_Declarative_Item_Of
              (Project_Declaration, To => Decl_Item);
            Set_Current_Item_Node (Decl_Item, To => Naming);
            Set_Name_Of (Naming, To => Name_Naming);
            Set_Project_Of_Renamed_Package_Of
              (Naming, To => Project_Naming_Node);
         end;

         --  Add an attribute declaration for Source_Dirs, initialized as an
         --  empty list. Directories will be added as they are read from the
         --  directory list file.

         declare
            Decl_Item  : constant Project_Node_Id :=
              Default_Project_Node (Of_Kind => N_Declarative_Item);

            Attribute : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Attribute_Declaration,
               And_Expr_Kind => List);

            Expression : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Expression,
               And_Expr_Kind => List);

            Term  : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Term, And_Expr_Kind => List);

         begin
            Set_Next_Declarative_Item
              (Decl_Item,
               To => First_Declarative_Item_Of (Project_Declaration));
            Set_First_Declarative_Item_Of
              (Project_Declaration, To => Decl_Item);
            Set_Current_Item_Node (Decl_Item, To => Attribute);
            Set_Name_Of (Attribute, To => Name_Source_Dirs);
            Set_Expression_Of (Attribute, To => Expression);
            Set_First_Term (Expression, To => Term);
            Source_Dirs_List :=
              Default_Project_Node (Of_Kind => N_Literal_String_List,
                                    And_Expr_Kind => List);
            Set_Current_Term (Term, To => Source_Dirs_List);
         end;

         --  Add an attribute declaration for Source_List_File with the
         --  source list file name that will be created.

         declare
            Decl_Item  : constant Project_Node_Id :=
              Default_Project_Node (Of_Kind => N_Declarative_Item);

            Attribute : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Attribute_Declaration,
               And_Expr_Kind => Single);

            Expression : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Expression,
               And_Expr_Kind => Single);

            Term  : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Term,
               And_Expr_Kind => Single);

            Value : constant Project_Node_Id :=
              Default_Project_Node
              (Of_Kind => N_Literal_String,
               And_Expr_Kind => Single);

         begin
            Set_Next_Declarative_Item
              (Decl_Item,
               To => First_Declarative_Item_Of (Project_Declaration));
            Set_First_Declarative_Item_Of
              (Project_Declaration, To => Decl_Item);
            Set_Current_Item_Node (Decl_Item, To => Attribute);
            Set_Name_Of (Attribute, To => Name_Source_List_File);
            Set_Expression_Of (Attribute, To => Expression);
            Set_First_Term (Expression, To => Term);
            Set_Current_Term (Term, To => Value);
            Name_Len := Source_List_Last;
            Name_Buffer (1 .. Name_Len) :=
              Source_List_Path (1 .. Source_List_Last);
            Set_String_Value_Of (Value, To => Name_Find);
         end;
      end if;

      --  Process each directory

      for Index in Directories'Range  loop

         declare
            Dir_Name    : constant String := Directories (Index).all;
            Last        : Natural := Dir_Name'Last;
            Recursively : Boolean := False;
         begin
            if Dir_Name'Length >= 4
              and then (Dir_Name (Last - 2 .. Last) = "/**")
            then
               Last := Last - 3;
               Recursively := True;
            end if;

            if Project_File then

               --  Add the directory in the list for attribute Source_Dirs

               declare
                  Expression : constant Project_Node_Id :=
                    Default_Project_Node
                    (Of_Kind => N_Expression,
                     And_Expr_Kind => Single);

                  Term : constant Project_Node_Id :=
                    Default_Project_Node
                    (Of_Kind => N_Term,
                     And_Expr_Kind => Single);

                  Value : constant Project_Node_Id :=
                    Default_Project_Node
                    (Of_Kind => N_Literal_String,
                     And_Expr_Kind => Single);

               begin
                  if Current_Source_Dir = Empty_Node then
                     Set_First_Expression_In_List
                       (Source_Dirs_List, To => Expression);
                  else
                     Set_Next_Expression_In_List
                       (Current_Source_Dir, To => Expression);
                  end if;

                  Current_Source_Dir := Expression;
                  Set_First_Term (Expression, To => Term);
                  Set_Current_Term (Term, To => Value);
                  Name_Len := Dir_Name'Length;
                  Name_Buffer (1 .. Name_Len) := Dir_Name;
                  Set_String_Value_Of (Value, To => Name_Find);
               end;
            end if;

            Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
         end;

      end loop;

      if Project_File then
         Close (Source_List_FD);
      end if;

      declare
         Discard : Boolean;

      begin
         --  Delete the file if it already exists

         Delete_File
           (Path_Name (Directory_Last + 1 .. Path_Last),
            Success => Discard);

         --  Create a new one

         if Opt.Verbose_Mode then
            Output.Write_Str ("Creating new file """);
            Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
            Output.Write_Line ("""");
         end if;

         Output_FD := Create_New_File
           (Path_Name (Directory_Last + 1 .. Path_Last),
            Fmode => Text);

         --  Fails if project file cannot be created

         if Output_FD = Invalid_FD then
            Prj.Com.Fail
              ("cannot create new """, Path_Name (1 .. Path_Last), """");
         end if;

         if Project_File then

            --  Output the project file

            Prj.PP.Pretty_Print
              (Project_Node,
               W_Char => Write_A_Char'Access,
               W_Eol  => Write_Eol'Access,
               W_Str  => Write_A_String'Access,
               Backward_Compatibility => False);
            Close (Output_FD);

            --  Delete the naming project file if it already exists

            Delete_File
              (Project_Naming_File_Name (1 .. Project_Naming_Last),
               Success => Discard);

            --  Create a new one

            if Opt.Verbose_Mode then
               Output.Write_Str ("Creating new naming project file """);
               Output.Write_Str (Project_Naming_File_Name
                                   (1 .. Project_Naming_Last));
               Output.Write_Line ("""");
            end if;

            Output_FD := Create_New_File
              (Project_Naming_File_Name (1 .. Project_Naming_Last),
               Fmode => Text);

            --  Fails if naming project file cannot be created

            if Output_FD = Invalid_FD then
               Prj.Com.Fail
                 ("cannot create new """,
                  Project_Naming_File_Name (1 .. Project_Naming_Last),
                  """");
            end if;

            --  Output the naming project file

            Prj.PP.Pretty_Print
              (Project_Naming_Node,
               W_Char => Write_A_Char'Access,
               W_Eol  => Write_Eol'Access,
               W_Str  => Write_A_String'Access,
               Backward_Compatibility => False);
            Close (Output_FD);

         else
            --  Write to the output file each entry in the SFN_Pragmas table
            --  as an pragma Source_File_Name.

            for Index in 1 .. SFN_Pragmas.Last loop
               Write_A_String ("pragma Source_File_Name");
               Write_Eol;
               Write_A_String ("  (");
               Write_A_String (SFN_Pragmas.Table (Index).Unit.all);
               Write_A_String (",");
               Write_Eol;

               if SFN_Pragmas.Table (Index).Spec then
                  Write_A_String ("   Spec_File_Name => """);

               else
                  Write_A_String ("   Body_File_Name => """);
               end if;

               Write_A_String (SFN_Pragmas.Table (Index).File.all);
               Write_A_String (""");");
               Write_Eol;
            end loop;

            Close (Output_FD);
         end if;
      end;

   end Make;

   ----------------
   -- Write_Char --
   ----------------
   procedure Write_A_Char (C : Character) is
   begin
      Write_A_String ((1 => C));
   end Write_A_Char;

   ---------------
   -- Write_Eol --
   ---------------

   procedure Write_Eol is
   begin
      Write_A_String ((1 => ASCII.LF));
   end Write_Eol;

   --------------------
   -- Write_A_String --
   --------------------

   procedure Write_A_String (S : String) is
      Str : String (1 .. S'Length);

   begin
      if S'Length > 0 then
         Str := S;

         if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
            Prj.Com.Fail ("disk full");
         end if;
      end if;
   end Write_A_String;

end Prj.Makr;