2005-11-14 Robert Dewar <dewar@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>

	* sem_elab.adb: Change name Is_Package to Is_Package_Or_Generic_Package
	(Check_Elab_Call): A call within a protected body is never an
	elaboration call, and does not require checking.
	(Same_Elaboration_Scope): Take into account protected types for both
	entities.
	(Activate_Elaborate_All_Desirable): New procedure

	* ali.ads, ali.adb: Implement new AD/ED for Elaborate_All/Elaborate
	desirable

	* binde.adb: Implement new AD/ED for Elaborate_All/Elaborate desirable
	(Elab_Error_Msg): Use -da to include internal unit links, not -de.

	* lib-writ.ads, lib-writ.adb: 
	Implement new AD/ED for Elaborate_All/Elaborate desirable
	Use new Elaborate_All_Desirable flag in N_With_Clause node

	* sinfo.ads, sinfo.adb (Actual_Designated_Subtype): New attribute for
	N_Free_Statement nodes.
	Define new class N_Subprogram_Instantiation
	Add Elaborate_Desirable flag to N_With_Clause node
	Add N_Delay_Statement (covering two kinds of delay)

	* debug.adb: Introduce d.f flag for compiler
	Add -da switch for binder



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

1 files changed, 47 insertions, 16 deletions

diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb
index 2985b90b9e9..acba7846418 100644
--- a/gcc/ada/binde.adb
+++ b/gcc/ada/binde.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 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- --
@@ -72,11 +72,16 @@ package body Binde is
       --  elaborated before unit X is elaborated. The Elab_All_Link list
       --  traces the dependencies in the latter case.
 
-      Elab_Desirable,
+      Elab_All_Desirable,
       --  This is just like Elab_All, except that the elaborate all was not
       --  explicitly present in the source, but rather was created by the
       --  front end, which decided that it was "desirable".
 
+      Elab_Desirable,
+      --  This is just like Elab, except that the elaborate was not
+      --  explicitly present in the source, but rather was created by the
+      --  front end, which decided that it was "desirable".
+
       Spec_First);
       --  After is a body, and Before is the corresponding spec
 
@@ -249,7 +254,7 @@ package body Binde is
       Link   : Elab_All_Id);
    --  Used to compute the transitive closure of elaboration links for an
    --  Elaborate_All pragma (Reason = Elab_All) or for an indication of
-   --  Elaborate_All_Desirable (Reason = Elab_Desirable). Unit After has
+   --  Elaborate_All_Desirable (Reason = Elab_All_Desirable). Unit After has
    --  a pragma Elaborate_All or the front end has determined that a reference
    --  probably requires Elaborate_All is required, and unit Before must be
    --  previously elaborated. First a link is built making sure that unit
@@ -268,8 +273,7 @@ package body Binde is
 
    function Make_Elab_Entry
      (Unam : Unit_Name_Type;
-      Link : Elab_All_Id)
-      return Elab_All_Id;
+      Link : Elab_All_Id) return Elab_All_Id;
    --  Make an Elab_All_Entries table entry with the given Unam and Link
 
    function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id;
@@ -800,9 +804,9 @@ package body Binde is
       SL : Successor_Link renames Succ.Table (S);
 
    begin
-      --  Nothing to do if internal unit involved and no -de flag
+      --  Nothing to do if internal unit involved and no -da flag
 
-      if not Debug_Flag_E
+      if not Debug_Flag_A
         and then
           (Is_Internal_File_Name (Units.Table (SL.Before).Sfile)
             or else
@@ -841,7 +845,7 @@ package body Binde is
               ("     reason: pragma Elaborate_All in unit &",
                Info => True);
 
-         when Elab_Desirable =>
+         when Elab_All_Desirable =>
             Error_Msg_Output
               ("     reason: implicit Elaborate_All in unit &",
                Info => True);
@@ -850,6 +854,15 @@ package body Binde is
               ("     recompile & with -gnatwl for full details",
                Info => True);
 
+         when Elab_Desirable =>
+            Error_Msg_Output
+              ("     reason: implicit Elaborate in unit &",
+               Info => True);
+
+            Error_Msg_Output
+              ("     recompile & with -gnatwl for full details",
+               Info => True);
+
          when Spec_First =>
             Error_Msg_Output
               ("     reason: spec always elaborated before body",
@@ -1092,7 +1105,7 @@ package body Binde is
                      --  Now establish all the links we need
 
                      Elab_All_Links
-                       (Withed_Unit, U, Elab_Desirable,
+                       (Withed_Unit, U, Elab_All_Desirable,
                         Make_Elab_Entry
                           (Withs.Table (W).Uname, No_Elab_All_Link));
 
@@ -1116,6 +1129,18 @@ package body Binde is
                           (Corresponding_Body (Withed_Unit), U, Elab);
                      end if;
 
+                     --  Elaborate_Desirable case, for this we establish
+                     --  the same links as above, but with a different reason.
+
+                  elsif Withs.Table (W).Elab_Desirable then
+                     Build_Link (Withed_Unit, U, Withed);
+
+                     if Units.Table (Withed_Unit).Utype = Is_Spec then
+                        Build_Link
+                          (Corresponding_Body (Withed_Unit),
+                           U, Elab_Desirable);
+                     end if;
+
                      --  Case of normal WITH with no elaboration pragmas, just
                      --  build the single link to the directly referenced unit
 
@@ -1137,8 +1162,7 @@ package body Binde is
 
    function Make_Elab_Entry
      (Unam : Unit_Name_Type;
-      Link : Elab_All_Id)
-      return Elab_All_Id
+      Link : Elab_All_Id) return Elab_All_Id
    is
    begin
       Elab_All_Entries.Increment_Last;
@@ -1153,7 +1177,6 @@ package body Binde is
 
    function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id is
       Info : constant Int := Get_Name_Table_Info (Uname);
-
    begin
       pragma Assert (Info /= 0 and then Unit_Id (Info) /= No_Unit_Id);
       return Unit_Id (Info);
@@ -1172,12 +1195,20 @@ package body Binde is
       --  Determines if U is a waiting body, defined as a body which has
       --  not been elaborated, but whose spec has been elaborated.
 
+      ---------------
+      -- Body_Unit --
+      ---------------
+
       function Body_Unit (U : Unit_Id) return Boolean is
       begin
          return Units.Table (U).Utype = Is_Body
            or else Units.Table (U).Utype = Is_Body_Only;
       end Body_Unit;
 
+      ------------------
+      -- Waiting_Body --
+      ------------------
+
       function Waiting_Body (U : Unit_Id) return Boolean is
       begin
          return Units.Table (U).Utype = Is_Body and then
@@ -1186,10 +1217,10 @@ package body Binde is
 
    --  Start of processing for Worse_Choice
 
-   --  Note: the checks here are applied in sequence, and the ordering is
-   --  significant (i.e. the more important criteria are applied first).
-
    begin
+      --  Note: the checks here are applied in sequence, and the ordering is
+      --  significant (i.e. the more important criteria are applied first).
+
       --  If either unit is internal, then use Better_Choice, since the
       --  language requires that predefined units not mess up in the choice
       --  of elaboration order, and for internal units, any problems are
@@ -1277,7 +1308,7 @@ package body Binde is
       First_Name : Boolean := True;
 
    begin
-      if ST.Reason in Elab_All .. Elab_Desirable then
+      if ST.Reason in Elab_All .. Elab_All_Desirable then
          L := ST.Elab_All_Link;
          while L /= No_Elab_All_Link loop
             Nam := Elab_All_Entries.Table (L).Needed_By;