2010-09-09 Ed Schonberg <schonberg@adacore.com>

	* sem.adb (Walk_Library_Items): Traverse context of subunits of the
	main unit.
	(Is_Subunit_Of_Main): Handle null nodes properly.

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* par-ch2.adb: Update comments.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2b99056..b81b46b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2010-09-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem.adb (Walk_Library_Items): Traverse context of subunits of the
+       main unit.
+       (Is_Subunit_Of_Main): Handle null nodes properly.
+
+2010-09-09  Robert Dewar  <dewar@adacore.com>
+
+       * par-ch2.adb: Update comments.
+
 2010-09-09  Ben Brosgol  <brosgol@adacore.com>
 
        * gnat_rm.texi: Minor wordsmithing of section on pragma Ordered.

diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index e0bf09d..f0a0bce 100644 (file)
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -501,11 +501,14 @@ package body Ch2 is
          Id_Present := False;
       end if;
 
-      if Identifier_Seen and not Id_Present and not CodePeer_Mode then
-         --  In CodePeer mode, we do not generate an error for compatibility
-         --  with legacy code, since this error can be safely ignored when
-         --  generating SCIL.
+      --  Diagnose error of "positional" argument for pragma appearing after
+      --  a "named" argument (quotes here are because that's not quite accurate
+      --  Ada RM terminology).
+
+      --  Since older GNAT versions did not generate this error, disable this
+      --  message in codepeer mode to help legacy code using codepeer.
 
+      if Identifier_Seen and not Id_Present and not CodePeer_Mode then
          Error_Msg_SC ("|pragma argument identifier required here");
          Error_Msg_SC ("\since previous argument had identifier (RM 2.8(4))");
       end if;

diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 2955b1c..d3d07cb 100644 (file)
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1985,15 +1985,47 @@ package body Sem is
       if not Done (Main_Unit) then
          Do_Main := True;
 
-         declare
+         Process_Main : declare
             Parent_CU : Node_Id;
             Body_CU   : Node_Id;
             Body_U    : Unit_Number_Type;
             Child     : Entity_Id;
 
+            function Is_Subunit_Of_Main (U : Node_Id) return Boolean;
+            --  If the main unit has subunits, their context may include
+            --  bodies that are needed in the body of main. We must examine
+            --  the context of the subunits, which are otherwise not made
+            --  explicit in the main unit.
+
+            ------------------------
+            -- Is_Subunit_Of_Main --
+            ------------------------
+
+            function Is_Subunit_Of_Main (U : Node_Id) return Boolean is
+               Lib : Node_Id;
+            begin
+               if No (U) then
+                  return False;
+               else
+                  Lib := Library_Unit (U);
+                  return Nkind (Unit (U)) = N_Subunit
+                    and then
+                      (Lib = Cunit (Main_Unit)
+                        or else Is_Subunit_Of_Main (Lib));
+               end if;
+            end Is_Subunit_Of_Main;
+
+         --  Start of processing for Process_Main
+
          begin
             Process_Bodies_In_Context (Main_CU);
 
+            for Unit_Num in Done'Range loop
+               if Is_Subunit_Of_Main (Cunit (Unit_Num)) then
+                  Process_Bodies_In_Context (Cunit (Unit_Num));
+               end if;
+            end loop;
+
             --  If the main unit is a child unit, parent bodies may be present
             --  because they export instances or inlined subprograms. Check for
             --  presence of these, which are not present in context clauses.
@@ -2023,7 +2055,7 @@ package body Sem is
 
             Do_Action (Main_CU, Unit (Main_CU));
             Done (Main_Unit) := True;
-         end;
+         end Process_Main;
       end if;
 
       if Debug_Unit_Walk then