* prj-makr.ads, prj-makr.adb : New files.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@51406 138bc75d-0d04-0410-961f-82ee72b054a4

3 files changed, 1085 insertions, 0 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b1147851d40..e33fc4a406c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,7 @@
+2002-03-27  Geert Bosch  <bosch@gnat.com>
+
+	* prj-makr.ads, prj-makr.adb : New files.
+
 2002-03-26  Neil Booth  <neil@daikokuya.demon.co.uk>
 
 	* misc.c (LANG_HOOKS_MARK_TREE): Redefine.
diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb
new file mode 100644
index 00000000000..b74b5664d49
--- /dev/null
+++ b/gcc/ada/prj-makr.adb
@@ -0,0 +1,1016 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             P R J . M A K R                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001-2002 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. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Csets;
+with Namet;    use Namet;
+with Opt;
+with Output;
+with Osint;    use Osint;
+with Prj;      use Prj;
+with Prj.Part;
+with Prj.PP;
+with Prj.Tree; use Prj.Tree;
+with Snames;   use Snames;
+with Stringt;  use Stringt;
+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
+
+   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
+
+   ----------
+   -- Make --
+   ----------
+
+   procedure Make
+     (File_Path         : String;
+      Project_File      : Boolean;
+      Directories       : Argument_List;
+      Name_Patterns     : Argument_List;
+      Excluded_Patterns : 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;
+
+      Source_List_Path : String (1 .. Output_Name'Length +
+                                        Source_List_File_Suffix'Length);
+      Source_List_Last : Natural;
+
+      Source_List_FD : File_Descriptor;
+
+      Str     : String (1 .. 2_000);
+      Last    : Natural;
+      Dir     : Dir_Type;
+
+      PD      : Process_Descriptor;
+      Result  : Expect_Match;
+      Matcher : constant Pattern_Matcher :=
+                  Compile (Expression => "expected|Unit.*\)|No such");
+
+      Args : Argument_List :=
+        (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");
+
+   begin
+      --  Do some needed initializations
+
+      Csets.Initialize;
+      Namet.Initialize;
+      Snames.Initialize;
+      Prj.Initialize;
+
+      SFN_Pragmas.Set_Last (0);
+
+      --  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 =>
+               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
+            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
+         begin
+            Excluded_Expressions (Index) :=
+              Compile (Pattern => Excluded_Patterns (Index).all, Glob => True);
+
+         exception
+            when Error_In_Regexp =>
+               Fail ("invalid regular expression """ &
+                     Excluded_Patterns (Index).all & '"');
+         end;
+      end loop;
+
+      for Index in Regular_Expressions'Range loop
+         begin
+            Regular_Expressions (Index) :=
+              Compile (Pattern => Name_Patterns (Index).all, Glob => True);
+
+         exception
+            when Error_In_Regexp =>
+               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);
+            Start_String;
+            Store_String_Chars
+              (Project_Naming_File_Name (1 .. Project_Naming_Last));
+            Set_String_Value_Of (With_Clause, To => End_String);
+         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);
+            Start_String;
+            Store_String_Chars (Source_List_Path (1 .. Source_List_Last));
+            Set_String_Value_Of (Value, To => End_String);
+         end;
+      end if;
+
+      --  Process each directory
+
+      for Index in Directories'Range  loop
+
+         declare
+            Dir_Name : constant String := Directories (Index).all;
+            Matched  : Matched_Type := False;
+
+         begin
+            if Opt.Verbose_Mode then
+               Output.Write_Str ("Processing directory """);
+               Output.Write_Str (Dir_Name);
+               Output.Write_Line ("""");
+            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);
+                  Start_String;
+                  Store_String_Chars (S => Dir_Name);
+                  Set_String_Value_Of (Value, To => End_String);
+               end;
+            end if;
+
+            --  Get the source file names from the directory.
+            --  Fails if the directory does not exist.
+
+            begin
+               Open (Dir, Dir_Name);
+
+            exception
+               when Directory_Error =>
+                  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
+                     Args (6) := 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_Specification);
+                                    else
+                                       Set_Name_Of
+                                         (Attribute,
+                                          To => Name_Implementation);
+                                    end if;
+
+                                    Start_String;
+                                    Store_String_Chars
+                                      (To_Lower
+                                       (S (S'First + 5 .. S'Last - 7)));
+                                    Set_Associative_Array_Index_Of
+                                      (Attribute, To => End_String);
+
+                                    Set_Expression_Of
+                                      (Attribute, To => Expression);
+                                    Set_First_Term (Expression, To => Term);
+                                    Set_Current_Term (Term, To => Value);
+
+                                    Start_String;
+                                    Store_String_Chars (Str (1 .. Last));
+                                    Set_String_Value_Of
+                                      (Value, To => End_String);
+                                 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
+                                    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);
+
+                  else
+                     if Very_Verbose then
+                        if Matched = False then
+                           Output.Write_Line ("no match");
+
+                        else
+                           Output.Write_Line ("excluded");
+                        end if;
+                     end if;
+                  end if;
+               end if;
+            end loop;
+
+            Close (Dir);
+         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
+            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);
+            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
+               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);
+            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
+            Fail ("disk full");
+         end if;
+      end if;
+   end Write_A_String;
+
+end Prj.Makr;
diff --git a/gcc/ada/prj-makr.ads b/gcc/ada/prj-makr.ads
new file mode 100644
index 00000000000..4bba35c6cc3
--- /dev/null
+++ b/gcc/ada/prj-makr.ads
@@ -0,0 +1,65 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             P R J . M A K R                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--             Copyright (C) 2001-2002 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. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Support for procedure Gnatname.
+
+--  For arbitrary naming schemes, create or update a project file,
+--  or create a configuration pragmas file.
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+package Prj.Makr is
+
+   procedure Make
+     (File_Path         : String;
+      Project_File      : Boolean;
+      Directories       : Argument_List;
+      Name_Patterns     : Argument_List;
+      Excluded_Patterns : Argument_List;
+      Very_Verbose      : Boolean);
+   --  Create a project file or a configuration pragmas file
+   --
+   --  Project_File is the path name of the project file. If the project
+   --  file already exists parse it and keep all the elements that are not
+   --  automatically generated.
+   --
+   --  Directory_List_File is the path name of a text file that
+   --  contains on each non empty line the path names of the source
+   --  directories for the project file. The source directories
+   --  are relative to the directory of the project file.
+   --
+   --  File_Name_Patterns is a GNAT.Regexp string pattern such as
+   --  ".*\.ads|.*\.adb" or any other pattern.
+   --
+   --  A project file (without any sources) is automatically generated
+   --  with the name <project>_naming. It contains a package Naming with
+   --  all the specs and bodies for the project.
+   --  A file containing the source file names is automatically
+   --  generated and used as the Source_File_List for the project file.
+
+end Prj.Makr;