2010-10-05 Eric Botcazou <ebotcazou@adacore.com>

	* exp_ch5.adb (Make_Field_Expr): Revert previous change (removed).

2010-10-05  Emmanuel Briot  <briot@adacore.com>

	* prj-dect.adb, prj-nmsc.adb, prj-attr.adb, snames.ads-tmpl
	(Aggregate projects): added support for parsing aggregate projects.
	In particular, check the presence and value of the new attributes
	related to aggregate projects, ie Project_Files, Project_Path
	and External.
	(Check_Attribute_Allowed, Check_Package_Allowed,
	Rename_Obsolescent_Attributes): new subprogram, extracting code
	from existing subprogram to keep their sizes smaller.
	(Check_Aggregate_Project, Check_Abstract_Project,
	Check_Missing_Sources): new subprograms
	(Check): remove comments that duplicated either the name of the
	following subprogram call, or the comment on that subprogram.
	* prj-part.adb (Check_Extending_All_Imports): New subprogram, extracted
	from Parse_Single_Project.
	(Check_Aggregate_Imports): new subprogram.



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

7 files changed, 643 insertions, 352 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4c5c8c8c705..c6a1af151b0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2010-10-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_ch5.adb (Make_Field_Expr): Revert previous change (removed).
+
+2010-10-05  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-dect.adb, prj-nmsc.adb, prj-attr.adb, snames.ads-tmpl
+	(Aggregate projects): added support for parsing aggregate projects.
+	In particular, check the presence and value of the new attributes
+	related to aggregate projects, ie Project_Files, Project_Path
+	and External.
+	(Check_Attribute_Allowed, Check_Package_Allowed,
+	Rename_Obsolescent_Attributes): new subprogram, extracting code
+	from existing subprogram to keep their sizes smaller.
+	(Check_Aggregate_Project, Check_Abstract_Project,
+	Check_Missing_Sources): new subprograms
+	(Check): remove comments that duplicated either the name of the
+	following subprogram call, or the comment on that subprogram.
+	* prj-part.adb (Check_Extending_All_Imports): New subprogram, extracted
+	from Parse_Single_Project.
+	(Check_Aggregate_Imports): new subprogram.
+
 2010-10-05  Vincent Celier  <celier@adacore.com>
 
 	* make.adb (Check): When compiling with -gnatc, recompile if the ALI
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 9f7e6c7abf1..60593b590c2 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -1223,13 +1223,6 @@ package body Exp_Ch5 is
          --  declaration for Typ. We need to use the actual entity because the
          --  type may be private and resolution by identifier alone would fail.
 
-         function Make_Field_Expr
-           (Comp_Ent : Entity_Id;
-            U_U      : Boolean) return Node_Id;
-         --  Common processing for one component for Make_Component_List_Assign
-         --  and Make_Field_Assign. Return the expression to be assigned for
-         --  component Comp_Ent.
-
          function Make_Component_List_Assign
            (CL  : Node_Id;
             U_U : Boolean := False) return List_Id;
@@ -1289,6 +1282,7 @@ package body Exp_Ch5 is
             Alts   : List_Id;
             DC     : Node_Id;
             DCH    : List_Id;
+            Expr   : Node_Id;
             Result : List_Id;
             V      : Node_Id;
 
@@ -1314,9 +1308,28 @@ package body Exp_Ch5 is
                   Next_Non_Pragma (V);
                end loop;
 
+               --  If we have an Unchecked_Union, use the value of the inferred
+               --  discriminant of the variant part expression as the switch
+               --  for the case statement. The case statement may later be
+               --  folded.
+
+               if U_U then
+                  Expr :=
+                    New_Copy (Get_Discriminant_Value (
+                      Entity (Name (VP)),
+                      Etype (Rhs),
+                      Discriminant_Constraint (Etype (Rhs))));
+               else
+                  Expr :=
+                    Make_Selected_Component (Loc,
+                      Prefix => Duplicate_Subexpr (Rhs),
+                      Selector_Name =>
+                        Make_Identifier (Loc, Chars (Name (VP))));
+               end if;
+
                Append_To (Result,
                  Make_Case_Statement (Loc,
-                   Expression   => Make_Field_Expr (Entity (Name (VP)), U_U),
+                   Expression => Expr,
                    Alternatives => Alts));
             end if;
 
@@ -1332,19 +1345,32 @@ package body Exp_Ch5 is
             U_U : Boolean := False) return Node_Id
          is
             A    : Node_Id;
+            Expr : Node_Id;
 
          begin
             --  In the case of an Unchecked_Union, use the discriminant
             --  constraint value as on the right hand side of the assignment.
 
+            if U_U then
+               Expr :=
+                 New_Copy (Get_Discriminant_Value (C,
+                   Etype (Rhs),
+                   Discriminant_Constraint (Etype (Rhs))));
+            else
+               Expr :=
+                 Make_Selected_Component (Loc,
+                   Prefix => Duplicate_Subexpr (Rhs),
+                   Selector_Name => New_Occurrence_Of (C, Loc));
+            end if;
+
             A :=
               Make_Assignment_Statement (Loc,
-                Name       =>
+                Name =>
                   Make_Selected_Component (Loc,
-                    Prefix        => Duplicate_Subexpr (Lhs),
+                    Prefix => Duplicate_Subexpr (Lhs),
                     Selector_Name =>
                       New_Occurrence_Of (Find_Component (L_Typ, C), Loc)),
-                Expression => Make_Field_Expr (C, U_U));
+                Expression => Expr);
 
             --  Set Assignment_OK, so discriminants can be assigned
 
@@ -1369,8 +1395,9 @@ package body Exp_Ch5 is
             Result : List_Id;
 
          begin
-            Result := New_List;
             Item := First (CI);
+            Result := New_List;
+
             while Present (Item) loop
 
                --  Look for components, but exclude _tag field assignment if
@@ -1390,32 +1417,6 @@ package body Exp_Ch5 is
             return Result;
          end Make_Field_Assigns;
 
-         ---------------------
-         -- Make_Field_Expr --
-         ---------------------
-
-         function Make_Field_Expr
-           (Comp_Ent : Entity_Id;
-            U_U      : Boolean) return Node_Id
-         is
-         begin
-            --  If we have an Unchecked_Union, use the value of the inferred
-            --  discriminant of the variant part expression.
-
-            if U_U then
-               return
-                 New_Copy (Get_Discriminant_Value
-                   (Comp_Ent,
-                    Etype (Rhs),
-                    Discriminant_Constraint (Etype (Rhs))));
-            else
-               return
-                 Make_Selected_Component (Loc,
-                   Prefix        => Duplicate_Subexpr (Rhs),
-                   Selector_Name => New_Occurrence_Of (Comp_Ent, Loc));
-            end if;
-         end Make_Field_Expr;
-
       --  Start of processing for Expand_Assign_Record
 
       begin
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index ef9a96d5710..86f5af1739d 100644
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -91,6 +91,12 @@ package body Prj.Attr is
    "SVexcluded_source_list_file#" &
    "LVinterfaces#" &
 
+   --  Projects (in aggregate projects)
+
+   "LVproject_files#" &
+   "LVproject_path#" &
+   "SAexternal#" &
+
    --  Libraries
 
    "SVlibrary_dir#" &
@@ -147,18 +153,20 @@ package body Prj.Attr is
    "Saruntime_source_dir#" &
 
    --  package Naming
+   --  Some attributes are obsolescent, and renamed in the tree (see
+   --  Prj.Dect.Rename_Obsolescent_Attributes).
 
    "Pnaming#" &
-   "Saspecification_suffix#" &
+   "Saspecification_suffix#" &  --  Always renamed to "spec_suffix" in tree
    "Saspec_suffix#" &
-   "Saimplementation_suffix#" &
+   "Saimplementation_suffix#" & --  Always renamed to "body_suffix" in tree
    "Sabody_suffix#" &
    "SVseparate_suffix#" &
    "SVcasing#" &
    "SVdot_replacement#" &
-   "sAspecification#" &
+   "sAspecification#" &  --  Always renamed to "spec" in project tree
    "sAspec#" &
-   "sAimplementation#" &
+   "sAimplementation#" & --  Always renamed to "body" in project tree
    "sAbody#" &
    "Laspecification_exceptions#" &
    "Laimplementation_exceptions#" &
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 51332d89dae..cd4b2d163a7 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -48,6 +48,31 @@ package body Prj.Dect is
    --  a case construction (In_Case_Construction) or none of those two
    --  (In_Project).
 
+   procedure Rename_Obsolescent_Attributes
+     (In_Tree         : Project_Node_Tree_Ref;
+      Attribute       : Project_Node_Id;
+      Current_Package : Project_Node_Id);
+   --  Rename obsolescent attributes in the tree.
+   --  When the attribute has been renamed since its initial introduction in
+   --  the design of projects, we replace the old name in the tree with the
+   --  new name, so that the code does not have to check both names forever.
+
+   procedure Check_Attribute_Allowed
+     (In_Tree         : Project_Node_Tree_Ref;
+      Project         : Project_Node_Id;
+      Attribute       : Project_Node_Id;
+      Flags           : Processing_Flags);
+   --  Chech whether the attribute is valid in this project.
+   --  In particular, depending on the type of project (qualifier), some
+   --  attributes might be disabled.
+
+   procedure Check_Package_Allowed
+     (In_Tree         : Project_Node_Tree_Ref;
+      Project         : Project_Node_Id;
+      Current_Package : Project_Node_Id;
+      Flags           : Processing_Flags);
+   --  Check whether the package is valid in this project
+
    procedure Parse_Attribute_Declaration
      (In_Tree           : Project_Node_Tree_Ref;
       Attribute         : out Project_Node_Id;
@@ -147,6 +172,111 @@ package body Prj.Dect is
         (Declarations, In_Tree, To => First_Declarative_Item);
    end Parse;
 
+   -----------------------------------
+   -- Rename_Obsolescent_Attributes --
+   -----------------------------------
+
+   procedure Rename_Obsolescent_Attributes
+     (In_Tree         : Project_Node_Tree_Ref;
+      Attribute       : Project_Node_Id;
+      Current_Package : Project_Node_Id) is
+   begin
+      if Present (Current_Package)
+        and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
+      then
+         case Name_Of (Attribute, In_Tree) is
+         when Snames.Name_Specification =>
+            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
+
+         when Snames.Name_Specification_Suffix =>
+            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
+
+         when Snames.Name_Implementation =>
+            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
+
+         when Snames.Name_Implementation_Suffix =>
+            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
+
+         when others =>
+            null;
+         end case;
+      end if;
+   end Rename_Obsolescent_Attributes;
+
+   ---------------------------
+   -- Check_Package_Allowed --
+   ---------------------------
+
+   procedure Check_Package_Allowed
+     (In_Tree         : Project_Node_Tree_Ref;
+      Project         : Project_Node_Id;
+      Current_Package : Project_Node_Id;
+      Flags           : Processing_Flags)
+   is
+      Qualif : constant Project_Qualifier :=
+        Project_Qualifier_Of (Project, In_Tree);
+      Name   : constant Name_Id := Name_Of (Current_Package, In_Tree);
+   begin
+      if Qualif = Aggregate
+        and then Name /= Snames.Name_Builder
+      then
+         Error_Msg_Name_1 := Name;
+         Error_Msg
+           (Flags,
+            "package %% is forbidden in aggregate projects",
+            Location_Of (Current_Package, In_Tree));
+      end if;
+   end Check_Package_Allowed;
+
+   -----------------------------
+   -- Check_Attribute_Allowed --
+   -----------------------------
+
+   procedure Check_Attribute_Allowed
+     (In_Tree         : Project_Node_Tree_Ref;
+      Project         : Project_Node_Id;
+      Attribute       : Project_Node_Id;
+      Flags           : Processing_Flags)
+   is
+      Qualif : constant Project_Qualifier :=
+        Project_Qualifier_Of (Project, In_Tree);
+      Name   : constant Name_Id := Name_Of (Attribute, In_Tree);
+   begin
+      case Qualif is
+         when Aggregate =>
+            if Name = Snames.Name_Languages
+              or else Name = Snames.Name_Source_Files
+              or else Name = Snames.Name_Source_List_File
+              or else Name = Snames.Name_Locally_Removed_Files
+              or else Name = Snames.Name_Excluded_Source_Files
+              or else Name = Snames.Name_Excluded_Source_List_File
+              or else Name = Snames.Name_Interfaces
+              or else Name = Snames.Name_Object_Dir
+              or else Name = Snames.Name_Exec_Dir
+              or else Name = Snames.Name_Source_Dirs
+              or else Name = Snames.Name_Inherit_Source_Path
+            then
+               Error_Msg_Name_1 := Name;
+               Error_Msg
+                 (Flags,
+                  "%% is not valid in aggregate projects",
+                  Location_Of (Attribute, In_Tree));
+            end if;
+
+         when others =>
+            if Name = Snames.Name_Project_Files
+              or else Name = Snames.Name_Project_Path
+              or else Name = Snames.Name_External
+            then
+               Error_Msg_Name_1 := Name;
+               Error_Msg
+                 (Flags,
+                  "%% is only valid in aggregate projects",
+                  Location_Of (Attribute, In_Tree));
+            end if;
+      end case;
+   end Check_Attribute_Allowed;
+
    ---------------------------------
    -- Parse_Attribute_Declaration --
    ---------------------------------
@@ -165,37 +295,28 @@ package body Prj.Dect is
       Attribute_Name         : Name_Id           := No_Name;
       Optional_Index         : Boolean           := False;
       Pkg_Id                 : Package_Node_Id   := Empty_Package;
-      Ignore                 : Boolean           := False;
-
-   begin
-      Attribute :=
-        Default_Project_Node
-          (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree);
-      Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
-      Set_Previous_Line_Node (Attribute);
 
-      --  Scan past "for"
+      procedure Process_Attribute_Name;
+      --  Read the name of the attribute, and check its type
 
-      Scan (In_Tree);
-
-      --  Body may be an attribute name
+      procedure Process_Associative_Array_Index;
+      --  Read the index of the associative array and check its validity
 
-      if Token = Tok_Body then
-         Token := Tok_Identifier;
-         Token_Name := Snames.Name_Body;
-      end if;
+      ----------------------------
+      -- Process_Attribute_Name --
+      ----------------------------
 
-      Expect (Tok_Identifier, "identifier");
-
-      if Token = Tok_Identifier then
+      procedure Process_Attribute_Name is
+         Ignore : Boolean;
+      begin
          Attribute_Name := Token_Name;
-         Set_Name_Of (Attribute, In_Tree, To => Token_Name);
+         Set_Name_Of (Attribute, In_Tree, To => Attribute_Name);
          Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
 
          --  Find the attribute
 
          Current_Attribute :=
-           Attribute_Node_Id_Of (Token_Name, First_Attribute);
+           Attribute_Node_Id_Of (Attribute_Name, First_Attribute);
 
          --  If the attribute cannot be found, create the attribute if inside
          --  an unknown package.
@@ -254,35 +375,22 @@ package body Prj.Dect is
          end if;
 
          Scan (In_Tree); --  past the attribute name
-      end if;
-
-      --  Change obsolete names of attributes to the new names
-
-      if Present (Current_Package)
-        and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
-      then
-         case Name_Of (Attribute, In_Tree) is
-         when Snames.Name_Specification =>
-            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
 
-         when Snames.Name_Specification_Suffix =>
-            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
-
-         when Snames.Name_Implementation =>
-            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
-
-         when Snames.Name_Implementation_Suffix =>
-            Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
-
-         when others =>
-            null;
-         end case;
-      end if;
+         --  Set the expression kind of the attribute
 
-      --  Associative array attributes
+         if Current_Attribute /= Empty_Attribute then
+            Set_Expression_Kind_Of
+              (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute));
+            Optional_Index := Optional_Index_Of (Current_Attribute);
+         end if;
+      end Process_Attribute_Name;
 
-      if Token = Tok_Left_Paren then
+      -------------------------------------
+      -- Process_Associative_Array_Index --
+      -------------------------------------
 
+      procedure Process_Associative_Array_Index is
+      begin
          --  If the attribute is not an associative array attribute, report
          --  an error. If this information is still unknown, set the kind
          --  to Associative_Array.
@@ -292,9 +400,8 @@ package body Prj.Dect is
          then
             Error_Msg (Flags,
                        "the attribute """ &
-                       Get_Name_String
-                          (Attribute_Name_Of (Current_Attribute)) &
-                       """ cannot be an associative array",
+                       Get_Name_String (Attribute_Name_Of (Current_Attribute))
+                       & """ cannot be an associative array",
                        Location_Of (Attribute, In_Tree));
 
          elsif Attribute_Kind_Of (Current_Attribute) = Unknown then
@@ -371,6 +478,35 @@ package body Prj.Dect is
          if Token = Tok_Right_Paren then
             Scan (In_Tree); --  past the right parenthesis
          end if;
+      end Process_Associative_Array_Index;
+
+   begin
+      Attribute :=
+        Default_Project_Node
+          (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree);
+      Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
+      Set_Previous_Line_Node (Attribute);
+
+      --  Scan past "for"
+
+      Scan (In_Tree);
+
+      --  Body may be an attribute name
+
+      if Token = Tok_Body then
+         Token := Tok_Identifier;
+         Token_Name := Snames.Name_Body;
+      end if;
+
+      Expect (Tok_Identifier, "identifier");
+      Process_Attribute_Name;
+      Rename_Obsolescent_Attributes (In_Tree, Attribute, Current_Package);
+      Check_Attribute_Allowed (In_Tree, Current_Project, Attribute, Flags);
+
+      --  Associative array attributes
+
+      if Token = Tok_Left_Paren then
+         Process_Associative_Array_Index;
 
       else
          --  If it is an associative array attribute and there are no left
@@ -390,14 +526,6 @@ package body Prj.Dect is
          end if;
       end if;
 
-      --  Set the expression kind of the attribute
-
-      if Current_Attribute /= Empty_Attribute then
-         Set_Expression_Kind_Of
-           (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute));
-         Optional_Index := Optional_Index_Of (Current_Attribute);
-      end if;
-
       Expect (Tok_Use, "USE");
 
       if Token = Tok_Use then
@@ -1149,6 +1277,9 @@ package body Prj.Dect is
          Scan (In_Tree);
       end if;
 
+      Check_Package_Allowed
+        (In_Tree, Current_Project, Package_Declaration, Flags);
+
       if Token = Tok_Renames then
          Renaming := True;
       elsif Token = Tok_Extends then
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 68c1849fa62..b4c91e828ed 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -282,6 +282,16 @@ package body Prj.Nmsc is
    --  Check the library attributes of project Project in project tree
    --  and modify its data Data accordingly.
 
+   procedure Check_Aggregate_Project
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data);
+   --  Check aggregate projects attributes
+
+   procedure Check_Abstract_Project
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data);
+   --  Check abstract projects attributes
+
    procedure Check_Programming_Languages
      (Project : Project_Id;
       Data    : in out Tree_Processing_Data);
@@ -432,9 +442,8 @@ package body Prj.Nmsc is
      (Project : in out Project_Processing_Data;
       Data    : in out Tree_Processing_Data);
    --  Find all the sources of project Project in project tree Data.Tree and
-   --  update its Data accordingly. This assumes that Data.First_Source has
-   --  been initialized with the list of excluded sources and special naming
-   --  exceptions.
+   --  update its Data accordingly. This assumes that the special naming
+   --  exceptions have already been processed.
 
    function Path_Name_Of
      (File_Name : File_Name_Type;
@@ -854,6 +863,73 @@ package body Prj.Nmsc is
       end if;
    end Canonical_Case_File_Name;
 
+   -----------------------------
+   -- Check_Aggregate_Project --
+   -----------------------------
+
+   procedure Check_Aggregate_Project
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data)
+   is
+      Project_Files : constant Prj.Variable_Value :=
+                        Prj.Util.Value_Of
+                          (Snames.Name_Project_Files,
+                           Project.Decl.Attributes,
+                           Data.Tree);
+   begin
+      if Project_Files.Default then
+         Error_Msg_Name_1 := Snames.Name_Project_Files;
+         Error_Msg
+           (Data.Flags,
+            "Attribute %% must be specified in aggregate project",
+            Project.Location, Project);
+      end if;
+   end Check_Aggregate_Project;
+
+   ----------------------------
+   -- Check_Abstract_Project --
+   ----------------------------
+
+   procedure Check_Abstract_Project
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data)
+   is
+      Source_Dirs      : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Source_Dirs,
+                              Project.Decl.Attributes, Data.Tree);
+      Source_Files     : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Source_Files,
+                              Project.Decl.Attributes, Data.Tree);
+      Source_List_File : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Source_List_File,
+                              Project.Decl.Attributes, Data.Tree);
+      Languages        : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Languages,
+                              Project.Decl.Attributes, Data.Tree);
+
+   begin
+      if Project.Source_Dirs /= Nil_String then
+         if Source_Dirs.Values  = Nil_String
+           and then Source_Files.Values = Nil_String
+           and then Languages.Values = Nil_String
+           and then Source_List_File.Default
+         then
+            Project.Source_Dirs := Nil_String;
+
+         else
+            Error_Msg
+              (Data.Flags,
+               "at least one of Source_Files, Source_Dirs or Languages "
+               & "must be declared empty for an abstract project",
+               Project.Location, Project);
+         end if;
+      end if;
+   end Check_Abstract_Project;
+
    -----------
    -- Check --
    -----------
@@ -862,60 +938,20 @@ package body Prj.Nmsc is
      (Project : Project_Id;
       Data    : in out Tree_Processing_Data)
    is
-      Extending : Boolean := False;
       Prj_Data  : Project_Processing_Data;
 
    begin
       Initialize (Prj_Data, Project);
 
-      Check_If_Externally_Built (Project, Data);
-
-      --  Object, exec and source directories
-
-      Get_Directories (Project, Data);
-
-      --  Get the programming languages
-
+      Check_If_Externally_Built   (Project, Data);
+      Get_Directories             (Project, Data);
       Check_Programming_Languages (Project, Data);
 
-      if Project.Qualifier = Dry
-        and then Project.Source_Dirs /= Nil_String
-      then
-         declare
-            Source_Dirs      : constant Variable_Value :=
-                                 Util.Value_Of
-                                   (Name_Source_Dirs,
-                                    Project.Decl.Attributes, Data.Tree);
-            Source_Files     : constant Variable_Value :=
-                                 Util.Value_Of
-                                   (Name_Source_Files,
-                                    Project.Decl.Attributes, Data.Tree);
-            Source_List_File : constant Variable_Value :=
-                                 Util.Value_Of
-                                   (Name_Source_List_File,
-                                    Project.Decl.Attributes, Data.Tree);
-            Languages        : constant Variable_Value :=
-                                 Util.Value_Of
-                                   (Name_Languages,
-                                    Project.Decl.Attributes, Data.Tree);
-
-         begin
-            if Source_Dirs.Values  = Nil_String
-              and then Source_Files.Values = Nil_String
-              and then Languages.Values = Nil_String
-              and then Source_List_File.Default
-            then
-               Project.Source_Dirs := Nil_String;
-
-            else
-               Error_Msg
-                 (Data.Flags,
-                  "at least one of Source_Files, Source_Dirs or Languages "
-                    & "must be declared empty for an abstract project",
-                  Project.Location, Project);
-            end if;
-         end;
-      end if;
+      case Project.Qualifier is
+         when Aggregate => Check_Aggregate_Project (Project, Data);
+         when Dry       => Check_Abstract_Project  (Project, Data);
+         when others    => null;
+      end case;
 
       --  Check configuration. This must be done even for gnatmake (even though
       --  no user configuration file was provided) since the default config we
@@ -923,91 +959,24 @@ package body Prj.Nmsc is
 
       Check_Configuration (Project, Data);
 
-      --  Library attributes
-
       Check_Library_Attributes (Project, Data);
 
       if Current_Verbosity = High then
          Show_Source_Dirs (Project, Data.Tree);
       end if;
 
-      Extending := Project.Extends /= No_Project;
-
       Check_Package_Naming (Project, Data);
 
-      --  Find the sources
-
-      if Project.Source_Dirs /= Nil_String then
+      if Project.Qualifier /= Aggregate then
          Look_For_Sources (Prj_Data, Data);
-
-         if not Project.Externally_Built
-           and then not Extending
-         then
-            declare
-               Language     : Language_Ptr;
-               Source       : Source_Id;
-               Alt_Lang     : Language_List;
-               Continuation : Boolean := False;
-               Iter         : Source_Iterator;
-
-            begin
-               Language := Project.Languages;
-               while Language /= No_Language_Index loop
-
-                  --  If there are no sources for this language, check if there
-                  --  are sources for which this is an alternate language.
-
-                  if Language.First_Source = No_Source
-                    and then (Data.Flags.Require_Sources_Other_Lang
-                               or else Language.Name = Name_Ada)
-                  then
-                     Iter := For_Each_Source (In_Tree => Data.Tree,
-                                              Project => Project);
-                     Source_Loop : loop
-                        Source := Element (Iter);
-                        exit Source_Loop when Source = No_Source
-                          or else Source.Language = Language;
-
-                        Alt_Lang := Source.Alternate_Languages;
-                        while Alt_Lang /= null loop
-                           exit Source_Loop when Alt_Lang.Language = Language;
-                           Alt_Lang := Alt_Lang.Next;
-                        end loop;
-
-                        Next (Iter);
-                     end loop Source_Loop;
-
-                     if Source = No_Source then
-
-                        Report_No_Sources
-                          (Project,
-                           Get_Name_String (Language.Display_Name),
-                           Data,
-                           Prj_Data.Source_List_File_Location,
-                           Continuation);
-                        Continuation := True;
-                     end if;
-                  end if;
-
-                  Language := Language.Next;
-               end loop;
-            end;
-         end if;
       end if;
 
-      --  If a list of sources is specified in attribute Interfaces, set
-      --  In_Interfaces only for the sources specified in the list.
-
       Check_Interfaces (Project, Data);
 
-      --  If it is a library project file, check if it is a standalone library
-
       if Project.Library then
          Check_Stand_Alone_Library (Project, Data);
       end if;
 
-      --  Put the list of Mains, if any, in the project data
-
       Get_Mains (Project, Data);
 
       Free (Prj_Data);
@@ -7242,6 +7211,68 @@ package body Prj.Nmsc is
       procedure Mark_Excluded_Sources;
       --  Mark as such the sources that are declared as excluded
 
+      procedure Check_Missing_Sources;
+      --  Check whether one of the languages has no sources, and report an
+      --  error when appropriate
+
+      ---------------------------
+      -- Check_Missing_Sources --
+      ---------------------------
+
+      procedure Check_Missing_Sources is
+         Extending    : constant Boolean :=
+           Project.Project.Extends /= No_Project;
+         Language     : Language_Ptr;
+         Source       : Source_Id;
+         Alt_Lang     : Language_List;
+         Continuation : Boolean := False;
+         Iter         : Source_Iterator;
+      begin
+         if not Project.Project.Externally_Built
+           and then not Extending
+         then
+            Language := Project.Project.Languages;
+            while Language /= No_Language_Index loop
+
+               --  If there are no sources for this language, check if there
+               --  are sources for which this is an alternate language.
+
+               if Language.First_Source = No_Source
+                 and then (Data.Flags.Require_Sources_Other_Lang
+                           or else Language.Name = Name_Ada)
+               then
+                  Iter := For_Each_Source (In_Tree => Data.Tree,
+                                           Project => Project.Project);
+                  Source_Loop : loop
+                     Source := Element (Iter);
+                     exit Source_Loop when Source = No_Source
+                       or else Source.Language = Language;
+
+                     Alt_Lang := Source.Alternate_Languages;
+                     while Alt_Lang /= null loop
+                        exit Source_Loop when Alt_Lang.Language = Language;
+                        Alt_Lang := Alt_Lang.Next;
+                     end loop;
+
+                     Next (Iter);
+                  end loop Source_Loop;
+
+                  if Source = No_Source then
+                     Report_No_Sources
+                       (Project.Project,
+                        Get_Name_String (Language.Display_Name),
+                        Data,
+                        Project.Source_List_File_Location,
+                        Continuation);
+                     Continuation := True;
+                  end if;
+               end if;
+
+               Language := Language.Next;
+            end loop;
+         end if;
+      end Check_Missing_Sources;
+
       ------------------
       -- Check_Object --
       ------------------
@@ -7416,13 +7447,16 @@ package body Prj.Nmsc is
    --  Start of processing for Look_For_Sources
 
    begin
-      Find_Excluded_Sources (Project, Data);
-
-      if Project.Project.Languages /= No_Language_Index then
-         Load_Naming_Exceptions (Project, Data);
-         Find_Sources (Project, Data);
-         Mark_Excluded_Sources;
-         Check_Object_Files;
+      if Project.Project.Source_Dirs /= Nil_String then
+         Find_Excluded_Sources (Project, Data);
+
+         if Project.Project.Languages /= No_Language_Index then
+            Load_Naming_Exceptions (Project, Data);
+            Find_Sources (Project, Data);
+            Mark_Excluded_Sources;
+            Check_Object_Files;
+            Check_Missing_Sources;
+         end if;
       end if;
 
       Object_File_Names_Htable.Reset (Object_Files);
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index b8abe571bc4..b10b5664573 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -125,8 +125,37 @@ package body Prj.Part is
       Key        => Name_Id,
       Hash       => Hash,
       Equal      => "=");
+
+   function Has_Circular_Dependencies
+     (Flags               : Processing_Flags;
+      Normed_Path_Name    : Path_Name_Type;
+      Canonical_Path_Name : Path_Name_Type) return Boolean;
+   --  Check for a circular dependency in the loaded project.
+   --  Generates an error message in such a case.
+
+   procedure Read_Project_Qualifier
+     (Flags              : Processing_Flags;
+      In_Tree            : Project_Node_Tree_Ref;
+      Is_Config_File     : Boolean;
+      Qualifier_Location : out Source_Ptr;
+      Project            : Project_Node_Id);
+   --  Check if there is a qualifier before the reserved word "project"
+
    --  Hash table to cache project path to avoid looking for them on the path
 
+   procedure Check_Extending_All_Imports
+     (Flags : Processing_Flags;
+      In_Tree : Project_Node_Tree_Ref;
+      Project : Project_Node_Id);
+   --  Check that a non extending-all project does not import an
+   --  extending-all project.
+
+   procedure Check_Aggregate_Imports
+     (Flags   : Processing_Flags;
+      In_Tree : Project_Node_Tree_Ref;
+      Project : Project_Node_Id);
+   --  Check that an aggregate project only imports abstract projects
+
    procedure Create_Virtual_Extending_Project
      (For_Project  : Project_Node_Id;
       Main_Project : Project_Node_Id;
@@ -916,6 +945,185 @@ package body Prj.Part is
       end loop;
    end Post_Parse_Context_Clause;
 
+   ---------------------------------
+   -- Check_Extending_All_Imports --
+   ---------------------------------
+
+   procedure Check_Extending_All_Imports
+     (Flags   : Processing_Flags;
+      In_Tree : Project_Node_Tree_Ref;
+      Project : Project_Node_Id)
+   is
+      With_Clause, Imported : Project_Node_Id;
+   begin
+      if not Is_Extending_All (Project, In_Tree) then
+         With_Clause := First_With_Clause_Of (Project, In_Tree);
+
+         while Present (With_Clause) loop
+            Imported := Project_Node_Of (With_Clause, In_Tree);
+
+            if Is_Extending_All (With_Clause, In_Tree) then
+               Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
+               Error_Msg (Flags, "cannot import extending-all project %%",
+                          Token_Ptr);
+               exit;
+            end if;
+
+            With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
+         end loop;
+      end if;
+   end Check_Extending_All_Imports;
+
+   -----------------------------
+   -- Check_Aggregate_Imports --
+   -----------------------------
+
+   procedure Check_Aggregate_Imports
+     (Flags   : Processing_Flags;
+      In_Tree : Project_Node_Tree_Ref;
+      Project : Project_Node_Id)
+   is
+      With_Clause, Imported : Project_Node_Id;
+   begin
+      if Project_Qualifier_Of (Project, In_Tree) = Aggregate then
+         With_Clause := First_With_Clause_Of (Project, In_Tree);
+
+         while Present (With_Clause) loop
+            Imported := Project_Node_Of (With_Clause, In_Tree);
+
+            if Project_Qualifier_Of (Imported, In_Tree) /= Dry then
+               Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
+               Error_Msg (Flags, "can only import abstract projects, not %%",
+                          Token_Ptr);
+               exit;
+            end if;
+
+            With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
+         end loop;
+      end if;
+   end Check_Aggregate_Imports;
+
+   ----------------------------
+   -- Read_Project_Qualifier --
+   ----------------------------
+
+   procedure Read_Project_Qualifier
+     (Flags              : Processing_Flags;
+      In_Tree            : Project_Node_Tree_Ref;
+      Is_Config_File     : Boolean;
+      Qualifier_Location : out Source_Ptr;
+      Project            : Project_Node_Id)
+   is
+      Proj_Qualifier : Project_Qualifier := Unspecified;
+   begin
+      Qualifier_Location := Token_Ptr;
+
+      if Token = Tok_Abstract then
+         Proj_Qualifier := Dry;
+         Scan (In_Tree);
+
+      elsif Token = Tok_Identifier then
+         case Token_Name is
+            when Snames.Name_Standard =>
+               Proj_Qualifier := Standard;
+               Scan (In_Tree);
+
+            when Snames.Name_Aggregate =>
+               Proj_Qualifier := Aggregate;
+               Scan (In_Tree);
+
+               if Token = Tok_Identifier and then
+                 Token_Name = Snames.Name_Library
+               then
+                  Proj_Qualifier := Aggregate_Library;
+                  Scan (In_Tree);
+               end if;
+
+            when Snames.Name_Library =>
+               Proj_Qualifier := Library;
+               Scan (In_Tree);
+
+            when Snames.Name_Configuration =>
+               if not Is_Config_File then
+                  Error_Msg
+                    (Flags,
+                     "configuration projects cannot belong to a user" &
+                     " project tree",
+                     Token_Ptr);
+               end if;
+
+               Proj_Qualifier := Configuration;
+               Scan (In_Tree);
+
+            when others =>
+               null;
+         end case;
+      end if;
+
+      if Is_Config_File and then Proj_Qualifier = Unspecified then
+
+         --  Set the qualifier to Configuration, even if the token doesn't
+         --  exist in the source file itself, so that we can differentiate
+         --  project files and configuration files later on.
+
+         Proj_Qualifier := Configuration;
+      end if;
+
+      if Proj_Qualifier /= Unspecified then
+         if Is_Config_File
+           and then Proj_Qualifier /= Configuration
+         then
+            Error_Msg (Flags,
+                       "a configuration project cannot be qualified except " &
+                       "as configuration project",
+                       Qualifier_Location);
+         end if;
+
+         Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
+      end if;
+   end Read_Project_Qualifier;
+
+   -------------------------------
+   -- Has_Circular_Dependencies --
+   -------------------------------
+
+   function Has_Circular_Dependencies
+     (Flags               : Processing_Flags;
+      Normed_Path_Name    : Path_Name_Type;
+      Canonical_Path_Name : Path_Name_Type) return Boolean is
+   begin
+      for Index in reverse 1 .. Project_Stack.Last loop
+         exit when Project_Stack.Table (Index).Limited_With;
+
+         if Canonical_Path_Name =
+           Project_Stack.Table (Index).Canonical_Path_Name
+         then
+            Error_Msg (Flags, "circular dependency detected", Token_Ptr);
+            Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
+            Error_Msg (Flags, "\  %% is imported by", Token_Ptr);
+
+            for Current in reverse 1 .. Project_Stack.Last loop
+               Error_Msg_Name_1 :=
+                 Name_Id (Project_Stack.Table (Current).Path_Name);
+
+               if Project_Stack.Table (Current).Canonical_Path_Name /=
+                 Canonical_Path_Name
+               then
+                  Error_Msg
+                    (Flags, "\  %% which itself is imported by", Token_Ptr);
+
+               else
+                  Error_Msg (Flags, "\  %%", Token_Ptr);
+                  exit;
+               end if;
+            end loop;
+
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Has_Circular_Dependencies;
+
    --------------------------
    -- Parse_Single_Project --
    --------------------------
@@ -962,7 +1170,6 @@ package body Prj.Part is
 
       Project_Comment_State : Tree.Comment_State;
 
-      Proj_Qualifier     : Project_Qualifier := Unspecified;
       Qualifier_Location : Source_Ptr;
 
    begin
@@ -988,38 +1195,12 @@ package body Prj.Part is
          Canonical_Path_Name := Name_Find;
       end;
 
-      --  Check for a circular dependency
-
-      for Index in reverse 1 .. Project_Stack.Last loop
-         exit when Project_Stack.Table (Index).Limited_With;
-
-         if Canonical_Path_Name =
-              Project_Stack.Table (Index).Canonical_Path_Name
-         then
-            Error_Msg (Flags, "circular dependency detected", Token_Ptr);
-            Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
-            Error_Msg (Flags, "\  %% is imported by", Token_Ptr);
-
-            for Current in reverse 1 .. Project_Stack.Last loop
-               Error_Msg_Name_1 :=
-                 Name_Id (Project_Stack.Table (Current).Path_Name);
-
-               if Project_Stack.Table (Current).Canonical_Path_Name /=
-                    Canonical_Path_Name
-               then
-                  Error_Msg
-                    (Flags, "\  %% which itself is imported by", Token_Ptr);
-
-               else
-                  Error_Msg (Flags, "\  %%", Token_Ptr);
-                  exit;
-               end if;
-            end loop;
-
-            Project := Empty_Node;
-            return;
-         end if;
-      end loop;
+      if Has_Circular_Dependencies
+        (Flags, Normed_Path_Name, Canonical_Path_Name)
+      then
+         Project := Empty_Node;
+         return;
+      end if;
 
       --  Put the new path name on the stack
 
@@ -1156,73 +1337,8 @@ package body Prj.Part is
       Set_Directory_Of (Project, In_Tree, Project_Directory);
       Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
 
-      --  Check if there is a qualifier before the reserved word "project"
-
-      Qualifier_Location := Token_Ptr;
-
-      if Token = Tok_Abstract then
-         Proj_Qualifier := Dry;
-         Scan (In_Tree);
-
-      elsif Token = Tok_Identifier then
-         case Token_Name is
-            when Snames.Name_Standard =>
-               Proj_Qualifier := Standard;
-               Scan (In_Tree);
-
-            when Snames.Name_Aggregate =>
-               Proj_Qualifier := Aggregate;
-               Scan (In_Tree);
-
-               if Token = Tok_Identifier and then
-                 Token_Name = Snames.Name_Library
-               then
-                  Proj_Qualifier := Aggregate_Library;
-                  Scan (In_Tree);
-               end if;
-
-            when Snames.Name_Library =>
-               Proj_Qualifier := Library;
-               Scan (In_Tree);
-
-            when Snames.Name_Configuration =>
-               if not Is_Config_File then
-                  Error_Msg
-                    (Flags,
-                     "configuration projects cannot belong to a user" &
-                     " project tree",
-                     Token_Ptr);
-               end if;
-
-               Proj_Qualifier := Configuration;
-               Scan (In_Tree);
-
-            when others =>
-               null;
-         end case;
-      end if;
-
-      if Is_Config_File and then Proj_Qualifier = Unspecified then
-
-         --  Set the qualifier to Configuration, even if the token doesn't
-         --  exist in the source file itself, so that we can differentiate
-         --  project files and configuration files later on.
-
-         Proj_Qualifier := Configuration;
-      end if;
-
-      if Proj_Qualifier /= Unspecified then
-         if Is_Config_File
-           and then Proj_Qualifier /= Configuration
-         then
-            Error_Msg (Flags,
-                       "a configuration project cannot be qualified except " &
-                       "as configuration project",
-                       Qualifier_Location);
-         end if;
-
-         Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
-      end if;
+      Read_Project_Qualifier
+        (Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
 
       Set_Location_Of (Project, In_Tree, Token_Ptr);
 
@@ -1513,7 +1629,7 @@ package body Prj.Part is
                      --  with sources, if it inherits sources from the project
                      --  it extends.
 
-                     if Proj_Qualifier = Dry and then
+                     if Project_Qualifier_Of (Project, In_Tree) = Dry and then
                        Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
                      then
                         Error_Msg
@@ -1529,31 +1645,8 @@ package body Prj.Part is
          end if;
       end if;
 
-      --  Check that a non extending-all project does not import an
-      --  extending-all project.
-
-      if not Is_Extending_All (Project, In_Tree) then
-         declare
-            With_Clause : Project_Node_Id :=
-                            First_With_Clause_Of (Project, In_Tree);
-            Imported    : Project_Node_Id := Empty_Node;
-
-         begin
-            With_Clause_Loop :
-            while Present (With_Clause) loop
-               Imported := Project_Node_Of (With_Clause, In_Tree);
-
-               if Is_Extending_All (With_Clause, In_Tree) then
-                  Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
-                  Error_Msg (Flags, "cannot import extending-all project %%",
-                             Token_Ptr);
-                  exit With_Clause_Loop;
-               end if;
-
-               With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
-            end loop With_Clause_Loop;
-         end;
-      end if;
+      Check_Extending_All_Imports (Flags, In_Tree, Project);
+      Check_Aggregate_Imports (Flags, In_Tree, Project);
 
       --  Check that a project with a name including a dot either imports
       --  or extends the project whose name precedes the last dot.
@@ -1571,7 +1664,7 @@ package body Prj.Part is
          Name_Len := Name_Len - 1;
       end loop;
 
-      --  If a dot was find, check if the parent project is imported
+      --  If a dot was found, check if the parent project is imported
       --  or extended.
 
       if Name_Len > 0 then
@@ -1728,7 +1821,7 @@ package body Prj.Part is
                   Node           => Project,
                   Canonical_Path => Canonical_Path_Name,
                   Extended       => Extended,
-                  Proj_Qualifier => Proj_Qualifier));
+                  Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
       end if;
 
       declare
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 411e3dbd3f0..efba4c6fc34 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1133,6 +1133,8 @@ package Snames is
    Name_Prefix                           : constant Name_Id := N + $;
    Name_Project                          : constant Name_Id := N + $;
    Name_Project_Dir                      : constant Name_Id := N + $;
+   Name_Project_Files                    : constant Name_Id := N + $;
+   Name_Project_Path                     : constant Name_Id := N + $;
    Name_Response_File_Format             : constant Name_Id := N + $;
    Name_Response_File_Switches           : constant Name_Id := N + $;
    Name_Roots                            : constant Name_Id := N + $; --  GPR