2005-06-14 Javier Miranda <miranda@adacore.com>

	    Jose Ruiz  <ruiz@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* lib-load.ads, lib-load.adb (Load_Unit): Addition of a new parameter
	that indicates if we are parsing a compilation unit found in a
	limited-with clause.
	It is use to avoid the circularity check.

	* par.ads, par.adb (Par): Addition of a new parameter to indicate if
	we are parsing a compilation unit found in a limited-with clause. This
	is use to avoid the circularity check.

	* par-load.adb (Load): Indicate Lib.Load_Unit if we are loading the
	unit as a consequence of parsing a limited-with clause. This is used
	to avoid the circularity check.

	* sem_ch10.adb: Suppress Ada 2005 unit warning if -gnatwY used
	(Analyze_Context): Limited-with clauses are now allowed
	in more compilation units.
	(Analyze_Subunit_Context, Check_Parent): Protect the frontend
	againts previously reported critical errors in context clauses
	(Install_Limited_Withed_Unit): Code cleanup plus static detection
	of two further errors: renamed subprograms and renamed packages
	are not allowed in limited with clauses.
	(Install_Siblings): Do not install private_with_clauses on the package
	declaration for a non-private child unit.
	(Re_Install_Parents): When a parent of the subunit is reinstalled,
	reset visibility of child units properly.
	(Install_Withed_Unit): When a child unit appears in a with_clause of its
	parent, it is immediately visible.


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

6 files changed, 154 insertions, 66 deletions

diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 59879f0a431..16d610aae0c 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -38,6 +38,7 @@ with Osint;    use Osint;
 with Osint.C;  use Osint.C;
 with Output;   use Output;
 with Par;
+with Restrict; use Restrict;
 with Scn;      use Scn;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
@@ -236,12 +237,13 @@ package body Lib.Load is
    ---------------
 
    function Load_Unit
-     (Load_Name  : Unit_Name_Type;
-      Required   : Boolean;
-      Error_Node : Node_Id;
-      Subunit    : Boolean;
-      Corr_Body  : Unit_Number_Type := No_Unit;
-      Renamings  : Boolean          := False) return Unit_Number_Type
+     (Load_Name         : Unit_Name_Type;
+      Required          : Boolean;
+      Error_Node        : Node_Id;
+      Subunit           : Boolean;
+      Corr_Body         : Unit_Number_Type := No_Unit;
+      Renamings         : Boolean          := False;
+      From_Limited_With : Boolean          := False) return Unit_Number_Type
    is
       Calling_Unit : Unit_Number_Type;
       Uname_Actual : Unit_Name_Type;
@@ -487,7 +489,7 @@ package body Lib.Load is
                        or else Acts_As_Spec (Units.Table (Unum).Cunit))
            and then (Nkind (Error_Node) /= N_With_Clause
                        or else not Limited_Present (Error_Node))
-
+           and then not From_Limited_With
          then
             if Debug_Flag_L then
                Write_Str ("  circular dependency encountered");
@@ -561,7 +563,8 @@ package body Lib.Load is
                Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
                Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
                Initialize_Scanner (Unum, Source_Index (Unum));
-               Discard_List (Par (Configuration_Pragmas => False));
+               Discard_List (Par (Configuration_Pragmas => False,
+                                  From_Limited_With     => From_Limited_With));
                Multiple_Unit_Index := Save_Index;
                Set_Loading (Unum, False);
             end;
@@ -606,8 +609,22 @@ package body Lib.Load is
             --  Generate message if unit required
 
             if Required and then Present (Error_Node) then
-
                if Is_Predefined_File_Name (Fname) then
+
+                  --  This is a predefined library unit which is not present
+                  --  in the run time. If a predefined unit is not available
+                  --  it may very likely be the case that there is also pragma
+                  --  Restriction forbidding its usage. This is typically the
+                  --  case when building a configurable run time, where the
+                  --  usage of certain run-time units units is restricted by
+                  --  means of both the corresponding pragma Restriction (such
+                  --  as No_Calendar), and by not including the unit. Hence,
+                  --  we check whether this predefined unit is forbidden, so
+                  --  that the message about the restriction violation is
+                  --  generated, if needed.
+
+                  Check_Restricted_Unit (Load_Name, Error_Node);
+
                   Error_Msg_Name_1 := Uname_Actual;
                   Error_Msg
                     ("% is not a predefined library unit", Load_Msg_Sloc);
diff --git a/gcc/ada/lib-load.ads b/gcc/ada/lib-load.ads
index 662fe8f2e72..afc8f38be70 100644
--- a/gcc/ada/lib-load.ads
+++ b/gcc/ada/lib-load.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005 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- --
@@ -104,12 +104,13 @@ package Lib.Load is
    --  and then closed on return.
 
    function Load_Unit
-     (Load_Name  : Unit_Name_Type;
-      Required   : Boolean;
-      Error_Node : Node_Id;
-      Subunit    : Boolean;
-      Corr_Body  : Unit_Number_Type := No_Unit;
-      Renamings  : Boolean          := False) return Unit_Number_Type;
+     (Load_Name         : Unit_Name_Type;
+      Required          : Boolean;
+      Error_Node        : Node_Id;
+      Subunit           : Boolean;
+      Corr_Body         : Unit_Number_Type := No_Unit;
+      Renamings         : Boolean          := False;
+      From_Limited_With : Boolean          := False) return Unit_Number_Type;
    --  This function loads and parses the unit specified by Load_Name (or
    --  returns the unit number for the previously constructed units table
    --  entry if this is not the first call for this unit). Required indicates
@@ -147,6 +148,10 @@ package Lib.Load is
    --  described in the documentation of this unit. If this parameter is
    --  set to True, then Load_Name may not be the real unit name and it
    --  is necessary to load parents to find the real name.
+   --
+   --  From_Limited_With is True if we are loading a unit X found in a
+   --  limited-with clause, or some unit in the context of X. It is used to
+   --  avoid the check on circular dependency (Ada 2005, AI-50217)
 
    function Create_Dummy_Package_Unit
      (With_Node : Node_Id;
diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb
index 30dd830a51b..4ed8b89838f 100644
--- a/gcc/ada/par-load.adb
+++ b/gcc/ada/par-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -360,11 +360,14 @@ begin
 
          Unum :=
            Load_Unit
-             (Load_Name  => Spec_Name,
-              Required   => False,
-              Subunit    => False,
-              Error_Node => With_Node,
-              Renamings  => True);
+             (Load_Name         => Spec_Name,
+              Required          => False,
+              Subunit           => False,
+              Error_Node        => With_Node,
+              Renamings         => True,
+              From_Limited_With => From_Limited_With
+                                     or else
+                                   Limited_Present (Context_Node));
 
          --  If we find the unit, then set spec pointer in the N_With_Clause
          --  to point to the compilation unit for the spec. Remember that
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 290ad0b74da..02ef4b0497d 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -50,8 +50,10 @@ with Tbuild;   use Tbuild;
 -- Par --
 ---------
 
-function Par (Configuration_Pragmas : Boolean) return List_Id is
-
+function Par
+  (Configuration_Pragmas : Boolean;
+   From_Limited_With     : Boolean := False) return List_Id
+is
    Num_Library_Units : Natural := 0;
    --  Count number of units parsed (relevant only in syntax check only mode,
    --  since in semantics check mode only a single unit is permitted anyway)
diff --git a/gcc/ada/par.ads b/gcc/ada/par.ads
index 7c5ee0879c5..97ba2090c29 100644
--- a/gcc/ada/par.ads
+++ b/gcc/ada/par.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---     Copyright (C) 1992,1993,1994,1995 Free Software Foundation, Inc.     --
+--          Copyright (C) 1992-2005 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- --
@@ -29,14 +29,18 @@
 
 with Types; use Types;
 
-function Par (Configuration_Pragmas : Boolean) return List_Id;
+function Par
+  (Configuration_Pragmas : Boolean;
+   From_Limited_With     : Boolean := False) return List_Id;
 --  Top level parsing routine. There are two cases:
 --
 --  If Configuration_Pragmas is False, Par parses a compilation unit in the
 --  current source file and sets the Cunit, Cunit_Entity and Unit_Name fields
 --  of the units table entry for Current_Source_Unit. On return the parse tree
 --  is complete, and decorated with any required implicit label declarations.
---  The value returned in this case is always No_List.
+--  The value returned in this case is always No_List. If From_Limited_With is
+--  True, we are parsing a compilation unit found in a limited-with clause (Ada
+--  2005, AI-50217)
 --
 --  If Configuration_Pragmas is True, Par parses a list of configuration
 --  pragmas from the current source file, and returns the list of pragmas.
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 0a7496c8e53..bb90be32e69 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -803,6 +803,7 @@ package body Sem_Ch10 is
    ---------------------
 
    procedure Analyze_Context (N : Node_Id) is
+      Ukind : constant Node_Kind := Nkind (Unit (N));
       Item  : Node_Id;
 
    begin
@@ -872,10 +873,22 @@ package body Sem_Ch10 is
          if Nkind (Item) = N_With_Clause
            and then Limited_Present (Item)
          then
-
-            if Nkind (Unit (N)) /= N_Package_Declaration then
-               Error_Msg_N ("limited with_clause only allowed in"
-                            & " package specification", Item);
+            --  Check the compilation unit containing the limited-with
+            --  clause
+
+            if Ukind /= N_Package_Declaration
+              and then Ukind /= N_Subprogram_Declaration
+              and then Ukind /= N_Subprogram_Renaming_Declaration
+              and then Ukind /= N_Generic_Package_Declaration
+              and then Ukind /= N_Generic_Package_Renaming_Declaration
+              and then Ukind /= N_Generic_Subprogram_Declaration
+              and then Ukind /= N_Generic_Procedure_Renaming_Declaration
+              and then Ukind /= N_Package_Instantiation
+              and then Ukind /= N_Package_Renaming_Declaration
+              and then Ukind /= N_Procedure_Instantiation
+            then
+               Error_Msg_N
+                 ("limited with_clause not allowed here", Item);
             end if;
 
             --  Skip analyzing with clause if no unit, see above
@@ -1337,16 +1350,21 @@ package body Sem_Ch10 is
          while Present (Item) loop
 
             if Nkind (Item) = N_With_Clause then
-               Unit_Name := Entity (Name (Item));
+               --  Protect the frontend against previous errors
+               --  in context clauses
 
-               while Is_Child_Unit (Unit_Name) loop
-                  Set_Is_Visible_Child_Unit (Unit_Name);
-                  Unit_Name := Scope (Unit_Name);
-               end loop;
+               if Nkind (Name (Item)) /= N_Selected_Component then
+                  Unit_Name := Entity (Name (Item));
 
-               if not Is_Immediately_Visible (Unit_Name) then
-                  Set_Is_Immediately_Visible (Unit_Name);
-                  Set_Context_Installed (Item);
+                  while Is_Child_Unit (Unit_Name) loop
+                     Set_Is_Visible_Child_Unit (Unit_Name);
+                     Unit_Name := Scope (Unit_Name);
+                  end loop;
+
+                  if not Is_Immediately_Visible (Unit_Name) then
+                     Set_Is_Immediately_Visible (Unit_Name);
+                     Set_Context_Installed (Item);
+                  end if;
                end if;
 
             elsif Nkind (Item) = N_Use_Package_Clause then
@@ -1376,7 +1394,13 @@ package body Sem_Ch10 is
 
          while Present (Item) loop
 
-            if Nkind (Item) = N_With_Clause then
+            if Nkind (Item) = N_With_Clause
+
+               --  Protect the frontend against previous errors in context
+               --  clauses
+
+              and then Nkind (Name (Item)) /= N_Selected_Component
+            then
                Unit_Name := Entity (Name (Item));
 
                while Is_Child_Unit (Unit_Name) loop
@@ -1424,8 +1448,16 @@ package body Sem_Ch10 is
 
          E := First_Entity (Current_Scope);
 
+         --  Make entities in scope visible again. For child units, restore
+         --  visibility only if they are actually in context.
+
          while Present (E) loop
-            Set_Is_Immediately_Visible (E);
+            if not Is_Child_Unit (E)
+              or else Is_Visible_Child_Unit (E)
+            then
+               Set_Is_Immediately_Visible (E);
+            end if;
+
             Next_Entity (E);
          end loop;
 
@@ -1708,7 +1740,10 @@ package body Sem_Ch10 is
                      "and version-dependent?",
                      Name (N));
 
-               elsif U_Kind = Ada_05_Unit and then Ada_Version = Ada_95 then
+               elsif U_Kind = Ada_05_Unit
+                 and then Ada_Version < Ada_05
+                 and then Warn_On_Ada_2005_Compatibility
+               then
                   Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
                end if;
             end;
@@ -2180,7 +2215,7 @@ package body Sem_Ch10 is
                 From_With_Type (Scope (Entity (Selector_Name (Name (Item)))))
             then
                Error_Msg_Sloc := Sloc (Item);
-               Error_Msg_N ("Missing With_Clause for With_Type_Clause#", N);
+               Error_Msg_N ("missing With_Clause for With_Type_Clause#", N);
             end if;
 
             Next (Item);
@@ -2934,6 +2969,19 @@ package body Sem_Ch10 is
       begin
          pragma Assert (Nkind (W) = N_With_Clause);
 
+         --  Protect the frontend against previous critical errors
+
+         case Nkind (Unit (Library_Unit (W))) is
+            when N_Subprogram_Declaration         |
+                 N_Package_Declaration            |
+                 N_Generic_Subprogram_Declaration |
+                 N_Generic_Package_Declaration    =>
+               null;
+
+            when others =>
+               return;
+         end case;
+
          --  Step 1: Check if the unlimited view is installed in the parent
 
          Item := First (Context_Items (P));
@@ -3275,10 +3323,18 @@ package body Sem_Ch10 is
       --  scope of each entity is an ancestor of the current unit.
 
       Item := First (Context_Items (N));
+
+      --  Do not install private_with_clauses if the unit is a package
+      --  declaration, unless it is itself a private child unit.
+
       while Present (Item) loop
          if Nkind (Item) = N_With_Clause
            and then not Implicit_With (Item)
            and then not Limited_Present (Item)
+           and then
+              (not Private_Present (Item)
+                or else Nkind (Unit (N)) /= N_Package_Declaration
+                or else Private_Present (N))
          then
             Id := Entity (Name (Item));
 
@@ -3373,28 +3429,12 @@ package body Sem_Ch10 is
 
    begin
       --  In case of limited with_clause on subprograms, generics, instances,
-      --  or generic renamings, the corresponding error was previously posted
-      --  and we have nothing to do here.
-
-      case Nkind (P_Unit) is
-
-         when N_Package_Declaration =>
-            null;
+      --  or renamings, the corresponding error was previously posted and we
+      --  have nothing to do here.
 
-         when N_Subprogram_Declaration                 |
-              N_Generic_Package_Declaration            |
-              N_Generic_Subprogram_Declaration         |
-              N_Package_Instantiation                  |
-              N_Function_Instantiation                 |
-              N_Procedure_Instantiation                |
-              N_Generic_Package_Renaming_Declaration   |
-              N_Generic_Procedure_Renaming_Declaration |
-              N_Generic_Function_Renaming_Declaration =>
-            return;
-
-         when others =>
-            raise Program_Error;
-      end case;
+      if Nkind (P_Unit) /= N_Package_Declaration then
+         return;
+      end if;
 
       P := Defining_Unit_Name (Specification (P_Unit));
 
@@ -3578,7 +3618,7 @@ package body Sem_Ch10 is
       --  analyzing the private part of the package).
 
       if Private_Present (With_Clause)
-        and then Nkind (Cunit (Current_Sem_Unit)) = N_Package_Declaration
+        and then Nkind (Unit (Parent (With_Clause))) = N_Package_Declaration
         and then not (Private_With_OK)
       then
          return;
@@ -3623,6 +3663,13 @@ package body Sem_Ch10 is
          elsif not Is_Visible_Child_Unit (Uname) then
             Set_Is_Visible_Child_Unit (Uname);
 
+            --  If the child unit appears in the context of its parent, it
+            --  is immediately visible.
+
+            if In_Open_Scopes (Scope (Uname)) then
+               Set_Is_Immediately_Visible (Uname);
+            end if;
+
             if Is_Generic_Instance (Uname)
               and then Ekind (Uname) in Subprogram_Kind
             then
@@ -4112,6 +4159,16 @@ package body Sem_Ch10 is
                          & "limited with_clauses", N);
             return;
 
+         when N_Subprogram_Renaming_Declaration =>
+            Error_Msg_N ("renamed subprograms not allowed in "
+                         & "limited with_clauses", N);
+            return;
+
+         when N_Package_Renaming_Declaration =>
+            Error_Msg_N ("renamed packages not allowed in "
+                         & "limited with_clauses", N);
+            return;
+
          when others =>
             raise Program_Error;
       end case;