2008-05-20 Vincent Celier <celier@adacore.com>

	* prj.adb (Hash (Project_Id)): New function
	(Project_Empty): Add new component Interfaces_Defined

	* prj.ads (Source_Data): New component Object_Linked
	(Language_Config): New components Object_Generated and Objects_Linked
	(Hash (Project_Id)): New function
	(Source_Data): New Boolean components In_Interfaces and
	Declared_In_Interfaces.
	(Project_Data): New Boolean component Interfaces_Defined

	* prj-attr.adb: 
	New project level attribute Object_Generated and Objects_Linked
	Add new project level attribute Interfaces

	* prj-dect.adb: Use functions Present and No throughout
	(Parse_Variable_Declaration): If a string type is specified as a simple
	name and is not found in the current project, look for it also in the
	ancestors of the project.

	* prj-makr.adb: 
	Replace procedure Make with procedures Initialize, Process and Finalize
	to implement H414-023: process different directories with different
	patterns.
	Use functions Present and No throughout

	* prj-makr.ads: 
	Replace procedure Make with procedures Initialize, Process and Finalize

	* prj-nmsc.adb
	(Add_Source): Set component Object_Exists and Object_Linked accordnig to
	the language configuration.
	(Process_Project_Level_Array_Attributes): Process new attributes
	Object_Generated and Object_Linked.
	(Report_No_Sources): New Boolean parameter Continuation, defaulted to
	False, to indicate that the erreor/warning is a continuation.
	(Check): Call Report_No_Sources with Contnuation = True after the first
	call.
	(Error_Msg): Process successively contnuation character and warning
	character.
	(Find_Explicit_Sources): Check that all declared sources have been found
	(Check_File): Indicate in hash table Source_Names when a declared source
	is found.
	(Check_File): Set Other_Part when found
	(Find_Explicit_Sources): In multi language mode, check if all exceptions
	to the naming scheme have been found. For Ada, report an error if an
	exception has not been found. Otherwise, disregard the exception.
	(Check_Interfaces): New procedure
	(Add_Source): When Other_Part is defined, set mutual pointers in spec
	and body.
	(Check): In multi-language mode, call Check_Interfaces
	(Process_Sources_In_Multi_Language_Mode): Set In_Interfaces to False
	for an excluded source.
	(Remove_Source): A source replacing a source in the interfaces is also
	in the interfaces.

	* prj-pars.adb: Use function Present

	* prj-part.adb: Use functions Present and No throughout
	(Parse_Single_Project): Set the parent project for child projects
	(Create_Virtual_Extending_Project): Register project with no qualifier
	(Parse_Single_Project): Allow an abstract project to be extend several
	times. Do not allow an abstract project to extend a non abstract
	project.

	* prj-pp.adb: Use functions Present and No throughout
	(Print): Take into account the full associative array attribute
	declarations.

	* prj-proc.adb: Use functions Present and No throughout
	(Expression): Call itself with the same From_Project_Node for the
	default value of an external reference.

	* prj-strt.adb: Use functions Present and No throughout
	(Parse_Variable_Reference): If a variable is specified as a simple name
	and is not found in the current project, look for it also in the
	ancestors of the project.

	* prj-tree.ads, prj-tree.adb (Present): New function
	(No): New function
	Use functions Present and No throughout
	(Parent_Project_Of): New function
	(Set_Parent_Project_Of): New procedure

	* snames.ads, snames.adb: 
	Add new standard names Object_Generated and Objects_Linked



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

1 files changed, 75 insertions, 53 deletions

diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 593874fad02..1e15fb207da 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -184,7 +184,7 @@ package body Prj.Dect is
          --  an unknown package.
 
          if Current_Attribute = Empty_Attribute then
-            if Current_Package /= Empty_Node
+            if Present (Current_Package)
               and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored
             then
                Pkg_Id := Package_Id_Of (Current_Package, In_Tree);
@@ -194,7 +194,7 @@ package body Prj.Dect is
                --  If not a valid attribute name, issue an error if inside
                --  a package that need to be checked.
 
-               Ignore := Current_Package /= Empty_Node and then
+               Ignore := Present (Current_Package) and then
                           Packages_To_Check /= All_Packages;
 
                if Ignore then
@@ -241,7 +241,7 @@ package body Prj.Dect is
 
       --  Change obsolete names of attributes to the new names
 
-      if Current_Package /= Empty_Node
+      if Present (Current_Package)
         and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
       then
          case Name_Of (Attribute, In_Tree) is
@@ -403,7 +403,7 @@ package body Prj.Dect is
                   The_Project := Imported_Or_Extended_Project_Of
                                    (Current_Project, In_Tree, Token_Name);
 
-                  if The_Project = Empty_Node then
+                  if No (The_Project) then
                      Error_Msg ("unknown project", Location);
                      Scan (In_Tree); --  past the project name
 
@@ -414,7 +414,7 @@ package body Prj.Dect is
                      --  If this is inside a package, a dot followed by the
                      --  name of the package must followed the project name.
 
-                     if Current_Package /= Empty_Node then
+                     if Present (Current_Package) then
                         Expect (Tok_Dot, "`.`");
 
                         if Token /= Tok_Dot then
@@ -445,7 +445,7 @@ package body Prj.Dect is
 
                               --  Look for the package node
 
-                              while The_Package /= Empty_Node
+                              while Present (The_Package)
                                 and then
                                 Name_Of (The_Package, In_Tree) /= Token_Name
                               loop
@@ -457,7 +457,7 @@ package body Prj.Dect is
                               --  If the package cannot be found in the
                               --  project, issue an error.
 
-                              if The_Package = Empty_Node then
+                              if No (The_Package) then
                                  The_Project := Empty_Node;
                                  Error_Msg_Name_2 := Project_Name;
                                  Error_Msg_Name_1 := Token_Name;
@@ -473,7 +473,7 @@ package body Prj.Dect is
                   end if;
                end if;
 
-               if The_Project /= Empty_Node then
+               if Present (The_Project) then
 
                   --  Looking for '<same attribute name>
 
@@ -503,7 +503,7 @@ package body Prj.Dect is
                   end if;
                end if;
 
-               if The_Project = Empty_Node then
+               if No (The_Project) then
 
                   --  If there were any problem, set the attribute id to null,
                   --  so that the node will not be recorded.
@@ -546,7 +546,7 @@ package body Prj.Dect is
                --  for the attribute, issue an error.
 
                if Current_Attribute /= Empty_Attribute
-                 and then Expression /= Empty_Node
+                 and then Present (Expression)
                  and then Variable_Kind_Of (Current_Attribute) /=
                  Expression_Kind_Of (Expression, In_Tree)
                then
@@ -639,10 +639,10 @@ package body Prj.Dect is
          end if;
       end if;
 
-      if Case_Variable /= Empty_Node then
+      if Present (Case_Variable) then
          String_Type := String_Type_Of (Case_Variable, In_Tree);
 
-         if String_Type = Empty_Node then
+         if No (String_Type) then
             Error_Msg ("variable """ &
                        Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
                        """ is not typed",
@@ -813,15 +813,15 @@ package body Prj.Dect is
                      The_Variable : Project_Node_Id := Empty_Node;
 
                   begin
-                     if Current_Package /= Empty_Node then
+                     if Present (Current_Package) then
                         The_Variable :=
                           First_Variable_Of (Current_Package, In_Tree);
-                     elsif Current_Project /= Empty_Node then
+                     elsif Present (Current_Project) then
                         The_Variable :=
                           First_Variable_Of (Current_Project, In_Tree);
                      end if;
 
-                     while The_Variable /= Empty_Node
+                     while Present (The_Variable)
                        and then Name_Of (The_Variable, In_Tree) /=
                                 Token_Name
                      loop
@@ -831,7 +831,7 @@ package body Prj.Dect is
                      --  It is an error to declare a variable in a case
                      --  construction for the first time.
 
-                     if The_Variable = Empty_Node then
+                     if No (The_Variable) then
                         Error_Msg
                           ("a variable cannot be declared " &
                            "for the first time here",
@@ -928,8 +928,8 @@ package body Prj.Dect is
          --  Insert an N_Declarative_Item in the tree, but only if
          --  Current_Declaration is not an empty node.
 
-         if Current_Declaration /= Empty_Node then
-            if Current_Declarative_Item = Empty_Node then
+         if Present (Current_Declaration) then
+            if No (Current_Declarative_Item) then
                Current_Declarative_Item :=
                  Default_Project_Node
                    (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
@@ -1056,13 +1056,13 @@ package body Prj.Dect is
                         First_Package_Of (Current_Project, In_Tree);
 
          begin
-            while Current /= Empty_Node
+            while Present (Current)
               and then Name_Of (Current, In_Tree) /= Token_Name
             loop
                Current := Next_Package_In_Project (Current, In_Tree);
             end loop;
 
-            if Current /= Empty_Node then
+            if Present (Current) then
                Error_Msg
                  ("package """ &
                   Get_Name_String (Name_Of (Package_Declaration, In_Tree)) &
@@ -1110,22 +1110,22 @@ package body Prj.Dect is
                                     (Current_Project, In_Tree),
                                    In_Tree);
             begin
-               while Clause /= Empty_Node loop
+               while Present (Clause) loop
                   --  Only non limited imported projects may be used in a
                   --  renames declaration.
 
                   The_Project :=
                     Non_Limited_Project_Node_Of (Clause, In_Tree);
-                  exit when The_Project /= Empty_Node
+                  exit when Present (The_Project)
                     and then Name_Of (The_Project, In_Tree) = Project_Name;
                   Clause := Next_With_Clause_Of (Clause, In_Tree);
                end loop;
 
-               if Clause = Empty_Node then
+               if No (Clause) then
                   --  As we have not found the project in the imports, we check
                   --  if it's the name of an eventual extended project.
 
-                  if Extended /= Empty_Node
+                  if Present (Extended)
                     and then Name_Of (Extended, In_Tree) = Project_Name
                   then
                      Set_Project_Of_Renamed_Package_Of
@@ -1152,8 +1152,8 @@ package body Prj.Dect is
                   if Name_Of (Package_Declaration, In_Tree) /= Token_Name then
                      Error_Msg ("not the same package name", Token_Ptr);
                   elsif
-                    Project_Of_Renamed_Package_Of
-                      (Package_Declaration, In_Tree) /= Empty_Node
+                    Present (Project_Of_Renamed_Package_Of
+                               (Package_Declaration, In_Tree))
                   then
                      declare
                         Current : Project_Node_Id :=
@@ -1163,14 +1163,14 @@ package body Prj.Dect is
                                        In_Tree);
 
                      begin
-                        while Current /= Empty_Node
+                        while Present (Current)
                           and then Name_Of (Current, In_Tree) /= Token_Name
                         loop
                            Current :=
                              Next_Package_In_Project (Current, In_Tree);
                         end loop;
 
-                        if Current = Empty_Node then
+                        if No (Current) then
                            Error_Msg
                              ("""" &
                               Get_Name_String (Token_Name) &
@@ -1272,27 +1272,27 @@ package body Prj.Dect is
          Set_Name_Of (String_Type, In_Tree, To => Token_Name);
 
          Current := First_String_Type_Of (Current_Project, In_Tree);
-         while Current /= Empty_Node
+         while Present (Current)
            and then
            Name_Of (Current, In_Tree) /= Token_Name
          loop
             Current := Next_String_Type (Current, In_Tree);
          end loop;
 
-         if Current /= Empty_Node then
+         if Present (Current) then
             Error_Msg ("duplicate string type name """ &
                        Get_Name_String (Token_Name) &
                        """",
                        Token_Ptr);
          else
             Current := First_Variable_Of (Current_Project, In_Tree);
-            while Current /= Empty_Node
+            while Present (Current)
               and then Name_Of (Current, In_Tree) /= Token_Name
             loop
                Current := Next_Variable (Current, In_Tree);
             end loop;
 
-            if Current /= Empty_Node then
+            if Present (Current) then
                Error_Msg ("""" &
                           Get_Name_String (Token_Name) &
                           """ is already a variable name", Token_Ptr);
@@ -1399,8 +1399,8 @@ package body Prj.Dect is
 
             if OK then
                declare
-                  Current : Project_Node_Id :=
-                              First_String_Type_Of (Current_Project, In_Tree);
+                  Proj    : Project_Node_Id := Current_Project;
+                  Current : Project_Node_Id := Empty_Node;
 
                begin
                   if Project_String_Type_Name /= No_Name then
@@ -1414,7 +1414,7 @@ package body Prj.Dect is
 
                      begin
                         if The_Project_Name_And_Node =
-                          Tree_Private_Part.No_Project_Name_And_Node
+                             Tree_Private_Part.No_Project_Name_And_Node
                         then
                            Error_Msg ("unknown project """ &
                                       Get_Name_String
@@ -1426,22 +1426,45 @@ package body Prj.Dect is
                            Current :=
                              First_String_Type_Of
                                (The_Project_Name_And_Node.Node, In_Tree);
+                           while
+                             Present (Current)
+                             and then
+                               Name_Of (Current, In_Tree) /= String_Type_Name
+                           loop
+                              Current := Next_String_Type (Current, In_Tree);
+                           end loop;
                         end if;
                      end;
-                  end if;
 
-                  while Current /= Empty_Node
-                    and then Name_Of (Current, In_Tree) /= String_Type_Name
-                  loop
-                     Current := Next_String_Type (Current, In_Tree);
-                  end loop;
+                  else
+                     --  Look for a string type with the correct name in this
+                     --  project or in any of its ancestors.
+
+                     loop
+                        Current :=
+                          First_String_Type_Of (Proj, In_Tree);
+                        while
+                          Present (Current)
+                          and then
+                            Name_Of (Current, In_Tree) /= String_Type_Name
+                        loop
+                           Current := Next_String_Type (Current, In_Tree);
+                        end loop;
+
+                        exit when Present (Current);
 
-                  if Current = Empty_Node then
+                        Proj := Parent_Project_Of (Proj, In_Tree);
+                        exit when No (Proj);
+                     end loop;
+                  end if;
+
+                  if No (Current) then
                      Error_Msg ("unknown string type """ &
                                 Get_Name_String (String_Type_Name) &
                                 """",
                                 Type_Location);
                      OK := False;
+
                   else
                      Set_String_Type_Of
                        (Variable, In_Tree, To => Current);
@@ -1471,7 +1494,7 @@ package body Prj.Dect is
          Optional_Index  => False);
       Set_Expression_Of (Variable, In_Tree, To => Expression);
 
-      if Expression /= Empty_Node then
+      if Present (Expression) then
          --  A typed string must have a single string value, not a list
 
          if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration
@@ -1491,27 +1514,27 @@ package body Prj.Dect is
             The_Variable : Project_Node_Id := Empty_Node;
 
          begin
-            if Current_Package /= Empty_Node then
+            if Present (Current_Package) then
                The_Variable := First_Variable_Of (Current_Package, In_Tree);
-            elsif Current_Project /= Empty_Node then
-               The_Variable :=  First_Variable_Of (Current_Project, In_Tree);
+            elsif Present (Current_Project) then
+               The_Variable := First_Variable_Of (Current_Project, In_Tree);
             end if;
 
-            while The_Variable /= Empty_Node
+            while Present (The_Variable)
               and then Name_Of (The_Variable, In_Tree) /= Variable_Name
             loop
                The_Variable := Next_Variable (The_Variable, In_Tree);
             end loop;
 
-            if The_Variable = Empty_Node then
-               if Current_Package /= Empty_Node then
+            if No (The_Variable) then
+               if Present (Current_Package) then
                   Set_Next_Variable
                     (Variable, In_Tree,
                      To => First_Variable_Of (Current_Package, In_Tree));
                   Set_First_Variable_Of
                     (Current_Package, In_Tree, To => Variable);
 
-               elsif Current_Project /= Empty_Node then
+               elsif Present (Current_Project) then
                   Set_Next_Variable
                     (Variable, In_Tree,
                      To => First_Variable_Of (Current_Project, In_Tree));
@@ -1521,8 +1544,8 @@ package body Prj.Dect is
 
             else
                if Expression_Kind_Of (Variable, In_Tree) /= Undefined then
-                  if
-                    Expression_Kind_Of (The_Variable, In_Tree) = Undefined
+                  if Expression_Kind_Of (The_Variable, In_Tree) =
+                                                            Undefined
                   then
                      Set_Expression_Kind_Of
                        (The_Variable, In_Tree,
@@ -1543,7 +1566,6 @@ package body Prj.Dect is
             end if;
          end;
       end if;
-
    end Parse_Variable_Declaration;
 
 end Prj.Dect;