[multiple changes]

2014-07-31  Vincent Celier  <celier@adacore.com>

	* projects.texi: Minor spelling error fix.

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document No_Elaboration_Code_All restriction.
	* lib-writ.adb, lib-load.adb: Initialize No_Elab_Code field in unit
	information.
	* lib.ads, lib.adb (No_Elab_Code): New field in unit information.
	* restrict.adb (Process_Restriction_Synonyms): Add handling
	of No_Elaboration_Code_All.
	* restrict.ads (Process_Restriction_Synonyms): Now handles
	No_Elaboration_Code_All.
	* sem_ch10.adb (Analyze_Context): Enforce transitive with for
	No_Elaboration_Code_All.
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Handle setting of No_Elab_Code in unit information. Handle
	No_Elaboration_Code_All.
	* snames.ads-tmpl (Name_No_Elaboration_Code): New name for
	pragma processing.
	(Name_No_Elaboration_Code_All): New name for pragma processing.

2014-07-31  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject array
	types with a null range and use the Esize of the component
	instead of its RM_Size to identify appropriate values.

2014-07-31  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb Add with and use clause for Aspects.
	(Freeze_Expression): Emit an error when a volatile constant lacks
	Boolean aspect Import.
	(Has_Boolean_Aspect_Import): New routine.

From-SVN: r213347

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 03aa74363a7aa9533d8a2e2a3de902db40f063e7..0da286d62bbb14c0dec02774ca3a36779c09af63 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,39 @@
+2014-07-31  Vincent Celier  <celier@adacore.com>
+
+       * projects.texi: Minor spelling error fix.
+
+2014-07-31  Robert Dewar  <dewar@adacore.com>
+
+       * gnat_rm.texi: Document No_Elaboration_Code_All restriction.
+       * lib-writ.adb, lib-load.adb: Initialize No_Elab_Code field in unit
+       information.
+       * lib.ads, lib.adb (No_Elab_Code): New field in unit information.
+       * restrict.adb (Process_Restriction_Synonyms): Add handling
+       of No_Elaboration_Code_All.
+       * restrict.ads (Process_Restriction_Synonyms): Now handles
+       No_Elaboration_Code_All.
+       * sem_ch10.adb (Analyze_Context): Enforce transitive with for
+       No_Elaboration_Code_All.
+       * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
+       Handle setting of No_Elab_Code in unit information. Handle
+       No_Elaboration_Code_All.
+       * snames.ads-tmpl (Name_No_Elaboration_Code): New name for
+       pragma processing.
+       (Name_No_Elaboration_Code_All): New name for pragma processing.
+
+2014-07-31  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject array
+       types with a null range and use the Esize of the component
+       instead of its RM_Size to identify appropriate values.
+
+2014-07-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * freeze.adb Add with and use clause for Aspects.
+       (Freeze_Expression): Emit an error when a volatile constant lacks
+       Boolean aspect Import.
+       (Has_Boolean_Aspect_Import): New routine.
+

 2014-07-31  Gary Dismukes  <dismukes@adacore.com>
 
        * exp_util.adb: Minor reformatting.
 2014-07-31  Gary Dismukes  <dismukes@adacore.com>
 
        * exp_util.adb: Minor reformatting.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 19debb301af52aece1a9c76063fba366d251738c..4638537a010c787f806ca5f0cc6157af4a51fb75 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4043,9 +4043,10 @@ package body Exp_Aggr is
 
       --    3. The array type has no atomic components
 
 
       --    3. The array type has no atomic components
 

-      --    4. The component type is discrete
+      --    4. The array type has no null ranges (the purpose of this is to
+      --       avoid a bogus warning for an out-of-range value).

 
 

-      --    5. The component size is a multiple of Storage_Unit
+      --    5. The component type is discrete

 
       --    6. The component size is Storage_Unit or the value is of the form
       --       M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
 
       --    6. The component size is Storage_Unit or the value is of the form
       --       M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)


@@ -4057,7 +4058,10 @@ package body Exp_Aggr is
 
       function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is
          Ctyp      : Entity_Id;
 
       function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is
          Ctyp      : Entity_Id;

+         Index     : Entity_Id;

          Expr      : Node_Id := N;
          Expr      : Node_Id := N;

+         Low       : Node_Id;
+         High      : Node_Id;

          Remainder : Uint;
          Value     : Uint;
          Nunits    : Nat;
          Remainder : Uint;
          Value     : Uint;
          Nunits    : Nat;


@@ -4081,6 +4085,17 @@ package body Exp_Aggr is
                return False;
             end if;
 
                return False;
             end if;
 

+            Index := First_Index (Ctyp);
+            while Present (Index) loop
+               Get_Index_Bounds (Index, Low, High);
+
+               if Is_Null_Range (Low, High) then
+                  return False;
+               end if;
+
+               Next_Index (Index);
+            end loop;
+

             Expr := Expression (First (Component_Associations (Expr)));
 
             for J in 1 .. Number_Dimensions (Ctyp) - 1 loop
             Expr := Expression (First (Component_Associations (Expr)));
 
             for J in 1 .. Number_Dimensions (Ctyp) - 1 loop


@@ -4100,9 +4115,7 @@ package body Exp_Aggr is
             end if;
          end loop;
 
             end if;
          end loop;
 

-         if not Is_Discrete_Type (Ctyp)
-           or else RM_Size (Ctyp) mod System_Storage_Unit /= 0
-         then
+         if not Is_Discrete_Type (Ctyp) then

             return False;
          end if;
 
             return False;
          end if;
 


@@ -4110,7 +4123,10 @@ package body Exp_Aggr is
 
          Analyze_And_Resolve (Expr, Ctyp);
 
 
          Analyze_And_Resolve (Expr, Ctyp);
 

-         Nunits := UI_To_Int (RM_Size (Ctyp) / System_Storage_Unit);
+         --  The back end uses the Esize as the precision of the type
+
+         Nunits := UI_To_Int (Esize (Ctyp)) / System_Storage_Unit;
+

          if Nunits = 1 then
             return True;
          end if;
          if Nunits = 1 then
             return True;
          end if;


@@ -4125,7 +4141,7 @@ package body Exp_Aggr is
             Value := Value - Expr_Value (Type_Low_Bound (Ctyp));
          end if;
 
             Value := Value - Expr_Value (Type_Low_Bound (Ctyp));
          end if;
 

-         --  0 and -1 immediately satisfy the last check
+         --  Values 0 and -1 immediately satisfy the last check

 
          if Value = Uint_0 or else Value = Uint_Minus_1 then
             return True;
 
          if Value = Uint_0 or else Value = Uint_Minus_1 then
             return True;

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index fb1b90485f79e495cbbf197e3d264449dd3344f8..4d502f17629a968caf4799b78e621cf9d66dce72 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
 --                                                                          --
 ------------------------------------------------------------------------------
 

+with Aspects;  use Aspects;

 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;


@@ -1849,6 +1850,10 @@ package body Freeze is
       --  Freeze record type, including freezing component types, and freezing
       --  primitive operations if this is a tagged type.
 
       --  Freeze record type, including freezing component types, and freezing
       --  primitive operations if this is a tagged type.
 

+      function Has_Boolean_Aspect_Import (E : Entity_Id) return Boolean;
+      --  Determine whether an arbitrary entity is subject to Boolean aspect
+      --  Import and its value is specified as True.
+

       procedure Wrap_Imported_Subprogram (E : Entity_Id);
       --  If E is an entity for an imported subprogram with pre/post-conditions
       --  then this procedure will create a wrapper to ensure that proper run-
       procedure Wrap_Imported_Subprogram (E : Entity_Id);
       --  If E is an entity for an imported subprogram with pre/post-conditions
       --  then this procedure will create a wrapper to ensure that proper run-


@@ -3548,6 +3553,39 @@ package body Freeze is
          end Check_Variant_Part;
       end Freeze_Record_Type;
 
          end Check_Variant_Part;
       end Freeze_Record_Type;
 

+      -------------------------------
+      -- Has_Boolean_Aspect_Import --
+      -------------------------------
+
+      function Has_Boolean_Aspect_Import (E : Entity_Id) return Boolean is
+         Decl : constant Node_Id := Declaration_Node (E);
+         Asp  : Node_Id;
+         Expr : Node_Id;
+
+      begin
+         if Has_Aspects (Decl) then
+            Asp := First (Aspect_Specifications (Decl));
+            while Present (Asp) loop
+               Expr := Expression (Asp);
+
+               --  The value of aspect Import is True when the expression is
+               --  either missing or it is explicitly set to True.
+
+               if Get_Aspect_Id (Asp) = Aspect_Import
+                 and then (No (Expr)
+                            or else (Compile_Time_Known_Value (Expr)
+                                      and then Is_True (Expr_Value (Expr))))
+               then
+                  return True;
+               end if;
+
+               Next (Asp);
+            end loop;
+         end if;
+
+         return False;
+      end Has_Boolean_Aspect_Import;
+

       ------------------------------
       -- Wrap_Imported_Subprogram --
       ------------------------------
       ------------------------------
       -- Wrap_Imported_Subprogram --
       ------------------------------


@@ -4454,6 +4492,7 @@ package body Freeze is
             if Ekind (E) = E_Constant
               and then (Has_Volatile_Components (E) or else Is_Volatile (E))
               and then not Is_Imported (E)
             if Ekind (E) = E_Constant
               and then (Has_Volatile_Components (E) or else Is_Volatile (E))
               and then not Is_Imported (E)

+              and then not Has_Boolean_Aspect_Import (E)

             then
                --  Make sure we actually have a pragma, and have not merely
                --  inherited the indication from elsewhere (e.g. an address
             then
                --  Make sure we actually have a pragma, and have not merely
                --  inherited the indication from elsewhere (e.g. an address

diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index c0bbfb882293dbd3c99f0d4a618ff1790bc5b2b0..d936cdb1d6b65ed928d89b989a2f30c055009530 100644 (file)
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -490,6 +490,7 @@ Partition-Wide Restrictions
 Program Unit Level Restrictions
 
 * No_Elaboration_Code::
 Program Unit Level Restrictions
 
 * No_Elaboration_Code::

+* No_Elaboration_Code_All::

 * No_Entry_Queue::
 * No_Implementation_Aspect_Specifications::
 * No_Implementation_Attributes::
 * No_Entry_Queue::
 * No_Implementation_Aspect_Specifications::
 * No_Implementation_Attributes::


@@ -10964,6 +10965,7 @@ other compilation units in the partition.
 
 @menu
 * No_Elaboration_Code::
 
 @menu
 * No_Elaboration_Code::

+* No_Elaboration_Code_All::

 * No_Entry_Queue::
 * No_Implementation_Aspect_Specifications::
 * No_Implementation_Attributes::
 * No_Entry_Queue::
 * No_Implementation_Aspect_Specifications::
 * No_Implementation_Attributes::


@@ -11024,6 +11026,22 @@ Note that this the implementation of this restriction requires full
 code generation. If it is used in conjunction with "semantics only"
 checking, then some cases of violations may be missed.
 
 code generation. If it is used in conjunction with "semantics only"
 checking, then some cases of violations may be missed.
 

+@node No_Elaboration_Code_All
+@unnumberedsubsec No_Elaboration_Code_All
+@findex No_Elaboration_Code_All
+
+This restriction is identical in semantic effects to
+@code{No_Elaboration_Code}, and
+for most purposes is treated simply as a synonym of @code{No_Elaboration_Code}.
+
+The difference is that if @code{No_Elaboration_Code_All} is used then it
+must appear within a package or subprogram spec. As is the case for
+@code{No_Elaboration_Code}, it also applies to the corresponding body if
+there is one. In addition, any with'ed unit must itself contain a
+@code{No_Elaboration_Code_All} restriction,
+thus allowing transitive enforcement of the requirement for no elaboration
+code to be generated.
+

 @node No_Entry_Queue
 @unnumberedsubsec No_Entry_Queue
 @findex No_Entry_Queue
 @node No_Entry_Queue
 @unnumberedsubsec No_Entry_Queue
 @findex No_Entry_Queue

diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 262cefe00a78f4446d78952c4572db2749f6f401..f1ef626ec6d5be05b30818b594c5014a9087ea0f 100644 (file)
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -221,6 +221,7 @@ package body Lib.Load is
         Main_Priority     => Default_Main_Priority,
         Main_CPU          => Default_Main_CPU,
         Munit_Index       => 0,
         Main_Priority     => Default_Main_Priority,
         Main_CPU          => Default_Main_CPU,
         Munit_Index       => 0,

+        No_Elab_Code      => None,

         Serial_Number     => 0,
         Source_Index      => No_Source_File,
         Unit_File_Name    => Get_File_Name (Spec_Name, Subunit => False),
         Serial_Number     => 0,
         Source_Index      => No_Source_File,
         Unit_File_Name    => Get_File_Name (Spec_Name, Subunit => False),


@@ -327,6 +328,7 @@ package body Lib.Load is
            Main_Priority     => Default_Main_Priority,
            Main_CPU          => Default_Main_CPU,
            Munit_Index       => 0,
            Main_Priority     => Default_Main_Priority,
            Main_CPU          => Default_Main_CPU,
            Munit_Index       => 0,

+           No_Elab_Code      => None,

            Serial_Number     => 0,
            Source_Index      => Main_Source_File,
            Unit_File_Name    => Fname,
            Serial_Number     => 0,
            Source_Index      => Main_Source_File,
            Unit_File_Name    => Fname,


@@ -690,6 +692,7 @@ package body Lib.Load is
               Main_Priority     => Default_Main_Priority,
               Main_CPU          => Default_Main_CPU,
               Munit_Index       => 0,
               Main_Priority     => Default_Main_Priority,
               Main_CPU          => Default_Main_CPU,
               Munit_Index       => 0,

+              No_Elab_Code      => None,

               Serial_Number     => 0,
               Source_Index      => Src_Ind,
               Unit_File_Name    => Fname,
               Serial_Number     => 0,
               Source_Index      => Src_Ind,
               Unit_File_Name    => Fname,

diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 92c43247e0518313334da9ea47172b26a1b5e4f2..61d48e22fc4a0d917ea04ec6e6c5914024ae8d35 100644 (file)
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -90,6 +90,7 @@ package body Lib.Writ is
          Main_Priority     => -1,
          Main_CPU          => -1,
          Munit_Index       => 0,
          Main_Priority     => -1,
          Main_CPU          => -1,
          Munit_Index       => 0,

+         No_Elab_Code      => None,

          Serial_Number     => 0,
          Version           => 0,
          Error_Location    => No_Location,
          Serial_Number     => 0,
          Version           => 0,
          Error_Location    => No_Location,


@@ -147,6 +148,7 @@ package body Lib.Writ is
         Main_Priority     => -1,
         Main_CPU          => -1,
         Munit_Index       => 0,
         Main_Priority     => -1,
         Main_CPU          => -1,
         Munit_Index       => 0,

+        No_Elab_Code      => None,

         Serial_Number     => 0,
         Version           => 0,
         Error_Location    => No_Location,
         Serial_Number     => 0,
         Version           => 0,
         Error_Location    => No_Location,

diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index 53b611d983ad213c3e08d2f565cada325c766b5b..b2f9c36e40e02313861ae6e8ba763f1506fb18c0 100644 (file)
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -146,6 +146,11 @@ package body Lib is
       return Units.Table (U).Munit_Index;
    end Munit_Index;
 
       return Units.Table (U).Munit_Index;
    end Munit_Index;
 

+   function No_Elab_Code (U : Unit_Number_Type) return No_Elab_Code_T is
+   begin
+      return Units.Table (U).No_Elab_Code;
+   end No_Elab_Code;
+

    function OA_Setting (U : Unit_Number_Type) return Character is
    begin
       return Units.Table (U).OA_Setting;
    function OA_Setting (U : Unit_Number_Type) return Character is
    begin
       return Units.Table (U).OA_Setting;


@@ -226,6 +231,11 @@ package body Lib is
       Units.Table (U).Main_Priority := P;
    end Set_Main_Priority;
 
       Units.Table (U).Main_Priority := P;
    end Set_Main_Priority;
 

+   procedure Set_No_Elab_Code (U : Unit_Number_Type; N : No_Elab_Code_T) is
+   begin
+      Units.Table (U).No_Elab_Code := N;
+   end Set_No_Elab_Code;
+

    procedure Set_OA_Setting (U : Unit_Number_Type; C : Character) is
    begin
       Units.Table (U).OA_Setting := C;
    procedure Set_OA_Setting (U : Unit_Number_Type; C : Character) is
    begin
       Units.Table (U).OA_Setting := C;

diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index a2a2410f5a7b948525e89471c9dc1857c76c012c..c5d3f4fefbaacda8894b277a4544d5c954515b7f 100644 (file)
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -347,6 +347,35 @@ package Lib is
    --      The index of the unit within the file for multiple unit per file
    --      mode. Set to zero in normal single unit per file mode.
 
    --      The index of the unit within the file for multiple unit per file
    --      mode. Set to zero in normal single unit per file mode.
 

+   --    No_Elab_Code
+   --      A value set when a pragma Restriction or Restriction_Warning for
+   --      No_Elaboration_Code_All or No_Elaboration_Code is encountered. This
+   --      is used to implement the transitive WITH rules (and for no other
+   --      purpose). The possible values are:
+
+   type No_Elab_Code_T is
+      (None,
+       --  The unit contains no Elaboration_Code[_All} restrictions
+
+       No_Elab_Code,
+       --  The unit contains a pragma Restrictions or Restriction_Warnings
+       --  for No_Elaboration_Code, but does not contain either pragma for
+       --  No_Elaboration_Code_All. Note: this setting is not currently used,
+       --  but we maintain it for possible future use (e.g. if we decide after
+       --  all that No_Elaboration_Code is good enough to satisfy the rule for
+       --  transitive with's for No_Elaborate_Code_All.
+
+       No_Elab_Code_All_Warn,
+       --  The unit contains a pragma Restrictions_Warning for restriction
+       --  No_Elaboration_Code_All (but does not contain a pragma Restrictions
+       --  for this restriction).
+
+       No_Elab_Code_All);
+       --  The unit contains a pragma Restrictions (No_Elaboration_Code_All)
+
+   pragma Ordered (No_Elab_Code_T);
+   --  This set of values is ordered, we record the highest value seen
+

    --    OA_Setting
    --      This is a character field containing L if Optimize_Alignment mode
    --      was set locally, and O/T/S for Off/Time/Space default if not.
    --    OA_Setting
    --      This is a character field containing L if Optimize_Alignment mode
    --      was set locally, and O/T/S for Off/Time/Space default if not.


@@ -410,6 +439,7 @@ package Lib is
    function Main_CPU          (U : Unit_Number_Type) return Int;
    function Main_Priority     (U : Unit_Number_Type) return Int;
    function Munit_Index       (U : Unit_Number_Type) return Nat;
    function Main_CPU          (U : Unit_Number_Type) return Int;
    function Main_Priority     (U : Unit_Number_Type) return Int;
    function Munit_Index       (U : Unit_Number_Type) return Nat;

+   function No_Elab_Code      (U : Unit_Number_Type) return No_Elab_Code_T;

    function OA_Setting        (U : Unit_Number_Type) return Character;
    function Source_Index      (U : Unit_Number_Type) return Source_File_Index;
    function Unit_File_Name    (U : Unit_Number_Type) return File_Name_Type;
    function OA_Setting        (U : Unit_Number_Type) return Character;
    function Source_Index      (U : Unit_Number_Type) return Source_File_Index;
    function Unit_File_Name    (U : Unit_Number_Type) return File_Name_Type;


@@ -426,6 +456,7 @@ package Lib is
    procedure Set_Ident_String      (U : Unit_Number_Type; N : Node_Id);
    procedure Set_Loading           (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Main_CPU          (U : Unit_Number_Type; P : Int);
    procedure Set_Ident_String      (U : Unit_Number_Type; N : Node_Id);
    procedure Set_Loading           (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Main_CPU          (U : Unit_Number_Type; P : Int);

+   procedure Set_No_Elab_Code      (U : Unit_Number_Type; N : No_Elab_Code_T);

    procedure Set_Main_Priority     (U : Unit_Number_Type; P : Int);
    procedure Set_OA_Setting        (U : Unit_Number_Type; C : Character);
    procedure Set_Unit_Name         (U : Unit_Number_Type; N : Unit_Name_Type);
    procedure Set_Main_Priority     (U : Unit_Number_Type; P : Int);
    procedure Set_OA_Setting        (U : Unit_Number_Type; C : Character);
    procedure Set_Unit_Name         (U : Unit_Number_Type; N : Unit_Name_Type);


@@ -726,6 +757,7 @@ private
    pragma Inline (Main_CPU);
    pragma Inline (Main_Priority);
    pragma Inline (Munit_Index);
    pragma Inline (Main_CPU);
    pragma Inline (Main_Priority);
    pragma Inline (Munit_Index);

+   pragma Inline (No_Elab_Code);

    pragma Inline (OA_Setting);
    pragma Inline (Set_Cunit);
    pragma Inline (Set_Cunit_Entity);
    pragma Inline (OA_Setting);
    pragma Inline (Set_Cunit);
    pragma Inline (Set_Cunit_Entity);


@@ -735,6 +767,7 @@ private
    pragma Inline (Set_Loading);
    pragma Inline (Set_Main_CPU);
    pragma Inline (Set_Main_Priority);
    pragma Inline (Set_Loading);
    pragma Inline (Set_Main_CPU);
    pragma Inline (Set_Main_Priority);

+   pragma Inline (Set_No_Elab_Code);

    pragma Inline (Set_OA_Setting);
    pragma Inline (Set_Unit_Name);
    pragma Inline (Source_Index);
    pragma Inline (Set_OA_Setting);
    pragma Inline (Set_Unit_Name);
    pragma Inline (Source_Index);


@@ -760,6 +793,7 @@ private
       Generate_Code     : Boolean;
       Has_RACW          : Boolean;
       Dynamic_Elab      : Boolean;
       Generate_Code     : Boolean;
       Has_RACW          : Boolean;
       Dynamic_Elab      : Boolean;

+      No_Elab_Code      : No_Elab_Code_T;

       Filler            : Boolean;
       Loading           : Boolean;
       OA_Setting        : Character;
       Filler            : Boolean;
       Loading           : Boolean;
       OA_Setting        : Character;


@@ -789,7 +823,8 @@ private
       Generate_Code     at 57 range 0 ..  7;
       Has_RACW          at 58 range 0 ..  7;
       Dynamic_Elab      at 59 range 0 ..  7;
       Generate_Code     at 57 range 0 ..  7;
       Has_RACW          at 58 range 0 ..  7;
       Dynamic_Elab      at 59 range 0 ..  7;

-      Filler            at 60 range 0 ..  15;
+      No_Elab_Code      at 60 range 0 ..  7;
+      Filler            at 61 range 0 ..  7;

       OA_Setting        at 62 range 0 ..  7;
       Loading           at 63 range 0 ..  7;
       SPARK_Mode_Pragma at 64 range 0 .. 31;
       OA_Setting        at 62 range 0 ..  7;
       Loading           at 63 range 0 ..  7;
       SPARK_Mode_Pragma at 64 range 0 .. 31;

diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index 65df6f732046093774811800a42b2baff7832134..54a43e0686ac5f69fcd572286ee6df96684ec3b1 100644 (file)
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -2728,7 +2728,7 @@ be ignored.
 Example:
 
 @smallexample @c projectfile
 Example:
 
 @smallexample @c projectfile

-for ^Switches^Switches^ (other) use ("-v", "-k", "-j8");
+for ^Switches^Switches^ (others) use ("-v", "-k", "-j8");

 @end smallexample
 
 These switches are only read from the main aggregate project (the
 @end smallexample
 
 These switches are only read from the main aggregate project (the

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 8983f78ee1cb9f4b7f9d29ef49422b367427d604..237ee4214094328d90de6218f44ef0e349b7a985 100644 (file)
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -883,6 +883,11 @@ package body Restrict is
          when Name_No_Task_Attributes =>
             New_Name := Name_No_Task_Attributes_Package;
 
          when Name_No_Task_Attributes =>
             New_Name := Name_No_Task_Attributes_Package;
 

+         --  No_Elaboration_Code_All is special, no warning needed
+
+         when Name_No_Elaboration_Code_All =>
+            return Name_No_Elaboration_Code;
+

          --  SPARK is special in that we unconditionally warn
 
          when Name_SPARK =>
          --  SPARK is special in that we unconditionally warn
 
          when Name_SPARK =>

diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index 5cae0d6bd5853df9a575b5283e97ef090697cbde..4f414aa0df86ba3c6e65903d64fde1361cc0825b 100644 (file)
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -336,6 +336,7 @@ package Restrict is
    --  Id is a node whose Chars field contains the name of a restriction.
    --  If it is one of synonyms that we allow for historical purposes (for
    --  list see System.Rident), then the proper official name is returned.
    --  Id is a node whose Chars field contains the name of a restriction.
    --  If it is one of synonyms that we allow for historical purposes (for
    --  list see System.Rident), then the proper official name is returned.

+   --  In addition, No_Elaboration_Code_All returns Name_No_Elaboration_Code.

    --  Otherwise the Chars field of the argument is returned unchanged.
 
    function Restriction_Active (R : All_Restrictions) return Boolean;
    --  Otherwise the Chars field of the argument is returned unchanged.
 
    function Restriction_Active (R : All_Restrictions) return Boolean;

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index aea29d098fe459fbd9328f9274c22fa5c42f576e..c0f874ea85715179f29e8038dc0198febc23678d 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1333,19 +1333,48 @@ package body Sem_Ch10 is
            and then not Limited_Present (Item)
          then
             --  Skip analyzing with clause if no unit, nothing to do (this
            and then not Limited_Present (Item)
          then
             --  Skip analyzing with clause if no unit, nothing to do (this

-            --  happens for a with that references a non-existent unit). Skip
-            --  as well if this is a with_clause for the main unit, which
-            --  happens if a subunit has a useless with_clause on its parent.
+            --  happens for a with that references a non-existent unit).

 
             if Present (Library_Unit (Item)) then
 
             if Present (Library_Unit (Item)) then

+
+               --  Skip analyzing with clause if this is a with_clause for
+               --  the main unit, which happens if a subunit has a useless
+               --  with_clause on its parent.
+

                if Library_Unit (Item) /= Cunit (Current_Sem_Unit) then
                   Analyze (Item);
 
                if Library_Unit (Item) /= Cunit (Current_Sem_Unit) then
                   Analyze (Item);
 

+                  --  This is the point at which we check for the case of an
+                  --  improper WITH from a unit with No_Elaboration_Code_All.
+
+                  if No_Elab_Code (Current_Sem_Unit) >=
+                       No_Elab_Code_All_Warn
+                  then
+                     if No_Elab_Code
+                          (Get_Source_Unit (Library_Unit (Item))) /=
+                             No_Elab_Code_All
+                     then
+                        Error_Msg_Warn :=
+                          No_Elab_Code (Current_Sem_Unit) =
+                            No_Elab_Code_All_Warn;
+                        Error_Msg_N
+                          ("<unit with No_Elaboration_Code_All has bad WITH",
+                           Item);
+                        Error_Msg_NE
+                          ("\<unit& does not have No_Elaboration_Code_All",
+                           Item, Entity (Name (Item)));
+                     end if;
+                  end if;
+
+               --  Here for the case of a useless with for the main unit
+

                else
                   Set_Entity (Name (Item), Cunit_Entity (Current_Sem_Unit));
                end if;
             end if;
 
                else
                   Set_Entity (Name (Item), Cunit_Entity (Current_Sem_Unit));
                end if;
             end if;
 

+            --  Do version update (skipped for implicit with)
+

             if not Implicit_With (Item) then
                Version_Update (N, Library_Unit (Item));
             end if;
             if not Implicit_With (Item) then
                Version_Update (N, Library_Unit (Item));
             end if;

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 2f04875b286dc6e06a49ca5e37616fa165879aca..1e46ac775db485f6c8d8dc06a5b7b29d43ffd745 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -5479,7 +5479,7 @@ package body Sem_Prag is
          --  Test-case should only appear in package spec unit
 
          if Get_Source_Unit (N) = No_Unit
          --  Test-case should only appear in package spec unit
 
          if Get_Source_Unit (N) = No_Unit

-           or else not Nkind_In (Sinfo.Unit (Cunit (Get_Source_Unit (N))),
+           or else not Nkind_In (Sinfo.Unit (Cunit (Current_Sem_Unit)),

                                  N_Package_Declaration,
                                  N_Generic_Package_Declaration)
          then
                                  N_Package_Declaration,
                                  N_Generic_Package_Declaration)
          then


@@ -5857,8 +5857,8 @@ package body Sem_Prag is
          if Nkind (P) = N_Compilation_Unit then
             Unit_Kind := Nkind (Unit (P));
 
          if Nkind (P) = N_Compilation_Unit then
             Unit_Kind := Nkind (Unit (P));
 

-            if Unit_Kind = N_Subprogram_Declaration
-              or else Unit_Kind = N_Package_Declaration
+            if Nkind_In (Unit_Kind, N_Subprogram_Declaration,
+                                    N_Package_Declaration)

               or else Unit_Kind in N_Generic_Declaration
             then
                Unit_Name := Defining_Entity (Unit (P));
               or else Unit_Kind in N_Generic_Declaration
             then
                Unit_Name := Defining_Entity (Unit (P));


@@ -8898,6 +8898,55 @@ package body Sem_Prag is
             Id := Chars (Arg);
             Expr := Get_Pragma_Arg (Arg);
 
             Id := Chars (Arg);
             Expr := Get_Pragma_Arg (Arg);
 

+            --  Special handling for No_Elaboration_Code
+
+            if Nkind (Expr) = N_Identifier
+              and then Chars (Expr) = Name_No_Elaboration_Code
+            then
+               if No_Elab_Code (Current_Sem_Unit) < No_Elab_Code then
+                  Set_No_Elab_Code (Current_Sem_Unit, No_Elab_Code);
+               end if;
+            end if;
+
+            --  Special handling for No_Elaboration_Code_All
+
+            if Nkind (Expr) = N_Identifier
+              and then Chars (Expr) = Name_No_Elaboration_Code_All
+            then
+               --  Must appear within a spec
+
+               if not Nkind_In (Unit (Cunit (Current_Sem_Unit)),
+                                N_Package_Declaration,
+                                N_Subprogram_Declaration)
+               then
+                  Error_Msg_Name_1 := Id;
+                  Error_Msg_N
+                    ("restriction% can appear only in package or "
+                     & "subprogram spec", Arg);
+               end if;
+
+               --  Set special value in unit table
+
+               declare
+                  New_Val : No_Elab_Code_T;
+
+               begin
+                  if Warn then
+                     New_Val := No_Elab_Code_All_Warn;
+                  else
+                     New_Val := No_Elab_Code_All;
+                  end if;
+
+                  if No_Elab_Code (Current_Sem_Unit) < New_Val then
+                     Set_No_Elab_Code (Current_Sem_Unit, New_Val);
+                  end if;
+               end;
+
+               --  Note that in the code below, Process_Restriction_Synonym
+               --  will treat No_Elaboration_Code_All like No_Elaboration_Code.
+
+            end if;
+

             --  Case of no restriction identifier present
 
             if Id = No_Name then
             --  Case of no restriction identifier present
 
             if Id = No_Name then

diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index a5791228df1231bf9e71ad8daed58717acfcfb5e..c8e555a4225e3849654481128e37e5c6ee859b24 100644 (file)
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -752,6 +752,8 @@ package Snames is
    Name_No_Dependence                  : constant Name_Id := N + $;
    Name_No_Dynamic_Attachment          : constant Name_Id := N + $;
    Name_No_Dynamic_Interrupts          : constant Name_Id := N + $;
    Name_No_Dependence                  : constant Name_Id := N + $;
    Name_No_Dynamic_Attachment          : constant Name_Id := N + $;
    Name_No_Dynamic_Interrupts          : constant Name_Id := N + $;

+   Name_No_Elaboration_Code            : constant Name_Id := N + $;
+   Name_No_Elaboration_Code_All        : constant Name_Id := N + $;

    Name_No_Implementation_Extensions   : constant Name_Id := N + $;
    Name_No_Obsolescent_Features        : constant Name_Id := N + $;
    Name_No_Requeue                     : constant Name_Id := N + $;
    Name_No_Implementation_Extensions   : constant Name_Id := N + $;
    Name_No_Obsolescent_Features        : constant Name_Id := N + $;
    Name_No_Requeue                     : constant Name_Id := N + $;