[multiple changes]

2015-05-22  Eric Botcazou  <ebotcazou@adacore.com>

	* sprint.adb (Source_Dump): When generating debug files, deal
	with the case of a stand-alone package instantiation by dumping
	together the spec and the body in the common debug file.

2015-05-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Minimum_Size): Size is zero for null range
	discrete subtype.

2015-05-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Anonymous_Master): This attribute now applies
	to package and subprogram bodies.
	(Set_Anonymous_Master): This attribute now applies to package and
	subprogram bodies.
	(Write_Field36_Name): Add output for package and subprogram bodies.
	* einfo.ads Update the documentation on attribute Anonymous_Master
	along with occurrences in entities.
	* exp_ch4.adb (Create_Anonymous_Master): Reimplemented to
	handle spec and body anonymous masters of the same unit.
	(Current_Anonymous_Master): Reimplemented. Handle a
	package instantiation that acts as a compilation unit.
	(Insert_And_Analyze): Reimplemented.

2015-05-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_With_Clause): A limited_with_clause on a
	predefined unit is treated as a regular with_clause.

From-SVN: r223557

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb5f5e73202d982ff5a79ed7628cecd68b1f0bb5..9c8ddbfaf3a44dc97a4e38f51dcb8c424eb48b84 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2015-05-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * sprint.adb (Source_Dump): When generating debug files, deal
+       with the case of a stand-alone package instantiation by dumping
+       together the spec and the body in the common debug file.
+
+2015-05-22  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch13.adb (Minimum_Size): Size is zero for null range
+       discrete subtype.
+
+2015-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * einfo.adb (Anonymous_Master): This attribute now applies
+       to package and subprogram bodies.
+       (Set_Anonymous_Master): This attribute now applies to package and
+       subprogram bodies.
+       (Write_Field36_Name): Add output for package and subprogram bodies.
+       * einfo.ads Update the documentation on attribute Anonymous_Master
+       along with occurrences in entities.
+       * exp_ch4.adb (Create_Anonymous_Master): Reimplemented to
+       handle spec and body anonymous masters of the same unit.
+       (Current_Anonymous_Master): Reimplemented. Handle a
+       package instantiation that acts as a compilation unit.
+       (Insert_And_Analyze): Reimplemented.
+
+2015-05-22  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch10.adb (Analyze_With_Clause): A limited_with_clause on a
+       predefined unit is treated as a regular with_clause.
+
 2015-05-22  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb,

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index bcbf20f54094ef657da5e9a97ca3993f8d910fcf..9b7cced24cbb384f15f4f913f719526c6bff76ef 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -757,7 +757,11 @@ package body Einfo is
 
    function Anonymous_Master (Id : E) return E is
    begin
-      pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
+      pragma Assert (Ekind_In (Id, E_Function,
+                                   E_Package,
+                                   E_Package_Body,
+                                   E_Procedure,
+                                   E_Subprogram_Body));
       return Node36 (Id);
    end Anonymous_Master;
 
@@ -3586,7 +3590,11 @@ package body Einfo is
 
    procedure Set_Anonymous_Master (Id : E; V : E) is
    begin
-      pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
+      pragma Assert (Ekind_In (Id, E_Function,
+                                   E_Package,
+                                   E_Package_Body,
+                                   E_Procedure,
+                                   E_Subprogram_Body));
       Set_Node36 (Id, V);
    end Set_Anonymous_Master;
 
@@ -10141,7 +10149,9 @@ package body Einfo is
          when E_Function                                   |
               E_Operator                                   |
               E_Package                                    |
-              E_Procedure                                  =>
+              E_Package_Body                               |
+              E_Procedure                                  |
+              E_Subprogram_Body                            =>
             Write_Str ("Anonymous_Master");
 
          when others                                       =>

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 550294f1c15092f16f8538f33273c08e04aa52cb..76a8ff7e098ad7b8a0ccc8666c56df2b2a744924 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -437,10 +437,10 @@ package Einfo is
 --       into an attribute definition clause for this purpose.
 
 --    Anonymous_Master (Node36)
---       Defined in the entities of non-generic subprogram and package units.
---       Contains the entity of a special heterogeneous finalization master
---       that services most anonymous access-to-controlled allocations that
---       occur within the unit.
+--       Defined in the entities of non-generic packages, subprograms and their
+--       corresponding bodies. Contains the entity of a special heterogeneous
+--       finalization master that services most anonymous access-to-controlled
+--       allocations that occur within the unit.
 
 --    Associated_Entity (Node37)
 --       Defined in all entities. This field is similar to Associated_Node, but
@@ -6096,6 +6096,7 @@ package Einfo is
    --    SPARK_Pragma                        (Node32)
    --    SPARK_Aux_Pragma                    (Node33)
    --    Contract                            (Node34)
+   --    Anonymous_Master                    (Node36)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    Delay_Subprogram_Descriptors        (Flag50)
    --    SPARK_Aux_Pragma_Inherited          (Flag266)
@@ -6320,6 +6321,7 @@ package Einfo is
    --    Extra_Formals                       (Node28)
    --    SPARK_Pragma                        (Node32)
    --    Contract                            (Node34)
+   --    Anonymous_Master                    (Node36)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Scope_Depth                         (synth)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index c268968dd03f2a9901655cbe05eaae384fe576e4..9f3be7eb2727d26777fb293c20c139832b3721f0 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -416,82 +416,134 @@ package body Exp_Ch4 is
 
    function Current_Anonymous_Master return Entity_Id is
       function Create_Anonymous_Master
-        (Unit_Id : Entity_Id;
-         Decls   : List_Id) return Entity_Id;
-      --  Create a new anonymous finalization master for a unit denoted by
-      --  Unit_Id. The declaration of the master along with any specialized
-      --  initialization is inserted at the top of declarative list Decls.
-      --  Return the entity of the anonymous master.
+        (Unit_Id   : Entity_Id;
+         Unit_Decl : Node_Id) return Entity_Id;
+      --  Create a new anonymous master for a compilation unit denoted by its
+      --  entity Unit_Id and declaration Unit_Decl. The declaration of the new
+      --  master along with any specialized initialization is inserted at the
+      --  top of the unit's declarations (see body for special cases). Return
+      --  the entity of the anonymous master.
 
       -----------------------------
       -- Create_Anonymous_Master --
       -----------------------------
 
       function Create_Anonymous_Master
-        (Unit_Id : Entity_Id;
-         Decls   : List_Id) return Entity_Id
+        (Unit_Id   : Entity_Id;
+         Unit_Decl : Node_Id) return Entity_Id
       is
-         First_Decl : Node_Id := Empty;
-         --  The first declaration of list Decls. This variable is used when
-         --  inserting various actions.
+         Insert_Nod : Node_Id := Empty;
+         --  The point of insertion into the declarative list of the unit. All
+         --  nodes are inserted before Insert_Nod.
 
-         procedure Insert_And_Analyze (Action : Node_Id);
-         --  Insert arbitrary node Action in declarative list Decl and analyze
-         --  it.
+         procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id);
+         --  Insert arbitrary node N in declarative list Decls and analyze it
 
          ------------------------
          -- Insert_And_Analyze --
          ------------------------
 
-         procedure Insert_And_Analyze (Action : Node_Id) is
+         procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id) is
          begin
-            --  The list is already populated, the actions are inserted at the
-            --  top of the list, preserving their order.
+            --  The declarative list is already populated, the nodes are
+            --  inserted at the top of the list, preserving their order.
 
-            if Present (First_Decl) then
-               Insert_Before_And_Analyze (First_Decl, Action);
+            if Present (Insert_Nod) then
+               Insert_Before (Insert_Nod, N);
 
             --  Otherwise append to the declarations to preserve order
 
             else
-               Append_To (Decls, Action);
-               Analyze (Action);
+               Append_To (Decls, N);
             end if;
+
+            Analyze (N);
          end Insert_And_Analyze;
 
          --  Local variables
 
-         Loc   : constant Source_Ptr := Sloc (Unit_Id);
-         FM_Id : Entity_Id;
+         Loc       : constant Source_Ptr := Sloc (Unit_Id);
+         Spec_Id   : constant Entity_Id  := Corresponding_Spec_Of (Unit_Decl);
+         Decls     : List_Id;
+         FM_Id     : Entity_Id;
+         Pref      : Character;
+         Unit_Spec : Node_Id;
 
       --  Start of processing for Create_Anonymous_Master
 
       begin
-         if Present (Decls) then
-            First_Decl := First (Decls);
+         --  Find the declarative list of the unit
+
+         if Nkind (Unit_Decl) = N_Package_Declaration then
+            Unit_Spec := Specification (Unit_Decl);
+            Decls := Visible_Declarations (Unit_Spec);
+
+            if No (Decls) then
+               Decls := New_List (Make_Null_Statement (Loc));
+               Set_Visible_Declarations (Unit_Spec, Decls);
+            end if;
+
+         --  Package or subprogram body
+
+         --  ??? A subprogram declaration that acts as a compilation unit may
+         --  contain a formal parameter of an anonymous access-to-controlled
+         --  type initialized by an allocator.
+
+         --    procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
+
+         --  There is no suitable place to create the anonymous master as the
+         --  subprogram is not in a declarative list.
+
+         else
+            Decls := Declarations (Unit_Decl);
+
+            if No (Decls) then
+               Decls := New_List (Make_Null_Statement (Loc));
+               Set_Declarations (Unit_Decl, Decls);
+            end if;
          end if;
 
+         --  The anonymous master and all initialization actions are inserted
+         --  before the first declaration (if any).
+
+         Insert_Nod := First (Decls);
+
          --  Since the anonymous master and all its initialization actions are
          --  inserted at top level, use the scope of the unit when analyzing.
 
-         Push_Scope (Unit_Id);
+         Push_Scope (Spec_Id);
 
-         --  Create the anonymous master
+         --  Step 1: Anonymous master creation
+
+         --  Use a unique prefix in case the same unit requires two anonymous
+         --  masters, one for the spec (S) and one for the body (B).
+
+         if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
+            Pref := 'S';
+         else
+            Pref := 'B';
+         end if;
 
          FM_Id :=
            Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Unit_Id), "AM"));
+             New_External_Name
+               (Related_Id => Chars (Unit_Id),
+                Suffix     => "AM",
+                Prefix     => Pref));
+
          Set_Anonymous_Master (Unit_Id, FM_Id);
 
          --  Generate:
          --    <FM_Id> : Finalization_Master;
 
-         Insert_And_Analyze
-           (Make_Object_Declaration (Loc,
+         Insert_And_Analyze (Decls,
+           Make_Object_Declaration (Loc,
              Defining_Identifier => FM_Id,
              Object_Definition   =>
                New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
 
+         --  Step 2: Initialization actions
+
          --  Do not set the base pool and mode of operation on .NET/JVM since
          --  those targets do not support pools and all VM masters defaulted to
          --  heterogeneous.
@@ -502,8 +554,8 @@ package body Exp_Ch4 is
             --    Set_Base_Pool
             --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
 
-            Insert_And_Analyze
-              (Make_Procedure_Call_Statement (Loc,
+            Insert_And_Analyze (Decls,
+              Make_Procedure_Call_Statement (Loc,
                 Name                   =>
                   New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
                 Parameter_Associations => New_List (
@@ -516,8 +568,8 @@ package body Exp_Ch4 is
             --  Generate:
             --    Set_Is_Heterogeneous (<FM_Id>);
 
-            Insert_And_Analyze
-              (Make_Procedure_Call_Statement (Loc,
+            Insert_And_Analyze (Decls,
+              Make_Procedure_Call_Statement (Loc,
                 Name                   =>
                   New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc),
                 Parameter_Associations => New_List (
@@ -530,48 +582,35 @@ package body Exp_Ch4 is
 
       --  Local declarations
 
-      Unit_Decl : constant Node_Id   := Unit (Cunit (Current_Sem_Unit));
-      Unit_Id   : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl);
-      Decls     : List_Id;
-      FM_Id     : Entity_Id;
-      Unit_Spec : Node_Id;
+      Unit_Decl : Node_Id;
+      Unit_Id   : Entity_Id;
 
    --  Start of processing for Current_Anonymous_Master
 
    begin
-      FM_Id := Anonymous_Master (Unit_Id);
-
-      --  Create a new anonymous master when allocating an object of anonymous
-      --  access-to-controlled type for the first time.
-
-      if No (FM_Id) then
+      Unit_Decl := Unit (Cunit (Current_Sem_Unit));
+      Unit_Id   := Defining_Entity (Unit_Decl);
 
-         --  Find the declarative list of the current unit
+      --  The compilation unit is a package instantiation. In this case the
+      --  anonymous master is associated with the package spec as both the
+      --  spec and body appear at the same level.
 
-         if Nkind (Unit_Decl) = N_Package_Declaration then
-            Unit_Spec := Specification (Unit_Decl);
-            Decls := Visible_Declarations (Unit_Spec);
-
-            if No (Decls) then
-               Decls := New_List;
-               Set_Visible_Declarations (Unit_Spec, Decls);
-            end if;
+      if Nkind (Unit_Decl) = N_Package_Body
+        and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
+      then
+         Unit_Id   := Corresponding_Spec (Unit_Decl);
+         Unit_Decl := Unit_Declaration_Node (Unit_Id);
+      end if;
 
-         --  Package or subprogram body
+      if Present (Anonymous_Master (Unit_Id)) then
+         return Anonymous_Master (Unit_Id);
 
-         else
-            Decls := Declarations (Unit_Decl);
-
-            if No (Decls) then
-               Decls := New_List;
-               Set_Declarations (Unit_Decl, Decls);
-            end if;
-         end if;
+      --  Create a new anonymous master when allocating an object of anonymous
+      --  access-to-controlled type for the first time.
 
-         FM_Id := Create_Anonymous_Master (Unit_Id, Decls);
+      else
+         return Create_Anonymous_Master (Unit_Id, Unit_Decl);
       end if;
-
-      return FM_Id;
    end Current_Anonymous_Master;
 
    --------------------------------

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 97933bbda36840bf297f56fa8d519e06a43f4a83..5824154b49cfaf3d2ea5a767596795f043118161 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2551,8 +2551,21 @@ package body Sem_Ch10 is
          --  Ada 2005 (AI-50217): Build visibility structures but do not
          --  analyze the unit.
 
+         --  If the designated unit is a predefined unit, which might be used
+         --  implicitly through the rtsfind machinery, a limited with clause
+         --  on such a unit is usually pointless, because run-time units are
+         --  unlikely to appear in mutually dependent units, and because this
+         --  disables the rtsfind mechanism. We transform such limited with
+         --  clauses into regular with clauses.
+
          if Sloc (U) /= No_Location then
-            Build_Limited_Views (N);
+            if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (U)))
+            then
+               Set_Limited_Present (N, False);
+               Analyze_With_Clause (N);
+            else
+               Build_Limited_Views (N);
+            end if;
          end if;
 
          return;

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7f951bcb7297d9065b48f65af139ab1b4c21c2b2..8a513833cb5f6e24aad17854664dc6b8480839a9 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11718,11 +11718,20 @@ package body Sem_Ch13 is
          Lo := Uint_0;
       end if;
 
+      --  Null range case, size is always zero. We only do this in the discrete
+      --  type case, since that's the odd case that came up. Probably we should
+      --  also do this in the fixed-point case, but doing so causes peculiar
+      --  gigi failures, and it is not worth worrying about this incredibly
+      --  marginal case (explicit null-range fixed-point type declarations)???
+
+      if Lo > Hi and then Is_Discrete_Type (T) then
+         S := 0;
+
       --  Signed case. Note that we consider types like range 1 .. -1 to be
       --  signed for the purpose of computing the size, since the bounds have
       --  to be accommodated in the base type.
 
-      if Lo < 0 or else Hi < 0 then
+      elsif Lo < 0 or else Hi < 0 then
          S := 1;
          B := Uint_1;
 

diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index bd772f3ab3586a5b5ced4680131fe1e3f0ced486..9e3dca627b34d0591fa912769e6204ba15d697b2 100644 (file)
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -624,11 +624,16 @@ package body Sprint is
          for U in Main_Unit .. Last_Unit loop
             Current_Source_File := Source_Index (U);
 
-            --  Dump all units if -gnatdf set, otherwise we dump only
-            --  the source files that are in the extended main source.
+            --  Dump all units if -gnatdf set, otherwise dump only the source
+            --  files that are in the extended main source. Note that, if we
+            --  are generating debug files, generating that of the main unit
+            --  has an effect on the outcome of In_Extended_Main_Source_Unit
+            --  because slocs are rewritten, so we also test for equality of
+            --  Cunit_Entity to work around this effect.
 
             if Debug_Flag_F
               or else In_Extended_Main_Source_Unit (Cunit_Entity (U))
+              or else Cunit_Entity (U) = Cunit_Entity (Main_Unit)
             then
                --  If we are generating debug files, setup to write them
 
@@ -638,6 +643,20 @@ package body Sprint is
                   First_Debug_Sloc := Debug_Sloc;
                   Write_Source_Line (1);
                   Last_Line_Printed := 1;
+
+                  --  If this unit has the same entity as the main unit, for
+                  --  example is the spec of a stand-alone instantiation of
+                  --  a package and the main unit is the body, its debug file
+                  --  will also be the same. Therefore, we need to print again
+                  --  the main unit to have both units in the debug file.
+
+                  if U /= Main_Unit
+                    and then Cunit_Entity (U) = Cunit_Entity (Main_Unit)
+                  then
+                     Sprint_Node (Cunit (Main_Unit));
+                     Write_Eol;
+                  end if;
+
                   Sprint_Node (Cunit (U));
                   Write_Source_Lines (Last_Source_Line (Current_Source_File));
                   Write_Eol;