s-rident.ads: Add various missing Ada 2012 restrictions...

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* s-rident.ads: Add various missing Ada 2012 restrictions:
	No_Access_Parameter_Allocators, No_Coextensions,
	No_Use_Of_Attribute, No_Use_Of_Pragma.
	* snames.ads-tmpl: Add corresponding names.
	* restrict.ads restrict.adb: Subprograms and data structures to
	handle aspects No_Use_Of_Attribute and No_Use_Of_Pragma.
	* sem_ch4.adb: Correct name of restrictions is
	No_Standard_Allocators_After_Elaboration.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
	violation of restriction No_Use_Of_Attribute.
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Set restrictions No_Use_Of_Pragma and No_Use_Of_Attribute.
	(Analyze_Pragma): Check violation of restriction No_Use_Of_Pragma.
	* sem_res.adb: Check restrictions No_Access_Parameter_Allocators
	and No_Coextensions.
	* bcheck.adb: Correct name of restrictions is
	No_Standard_Allocators_After_Elaboration.
	* gnatbind.adb: Correct name of restrictions is
	No_Standard_Allocators_After_Elaboration.

From-SVN: r197907

gcc/ada/ChangeLog

+2013-04-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* s-rident.ads: Add various missing Ada 2012 restrictions:
+	No_Access_Parameter_Allocators, No_Coextensions,
+	No_Use_Of_Attribute, No_Use_Of_Pragma.
+	* snames.ads-tmpl: Add corresponding names.
+	* restrict.ads restrict.adb: Subprograms and data structures to
+	handle aspects No_Use_Of_Attribute and No_Use_Of_Pragma.
+	* sem_ch4.adb: Correct name of restrictions is
+	No_Standard_Allocators_After_Elaboration.
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
+	violation of restriction No_Use_Of_Attribute.
+	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
+	Set restrictions No_Use_Of_Pragma and No_Use_Of_Attribute.
+	(Analyze_Pragma): Check violation of restriction No_Use_Of_Pragma.
+	* sem_res.adb: Check restrictions No_Access_Parameter_Allocators
+	and No_Coextensions.
+	* bcheck.adb: Correct name of restrictions is
+	No_Standard_Allocators_After_Elaboration.
+	* gnatbind.adb: Correct name of restrictions is
+	No_Standard_Allocators_After_Elaboration.
+
 2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_Pragma, (Check_Mode_Restriction_In_Function):

gcc/ada/bcheck.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -923,9 +923,9 @@ package body Bcheck is
         and then ALIs.Table (ALIs.First).Allocator_In_Body
       then
          Cumulative_Restrictions.Violated
-           (No_Allocators_After_Elaboration) := True;
+           (No_Standard_Allocators_After_Elaboration) := True;
          ALIs.Table (ALIs.First).Restrictions.Violated
-           (No_Allocators_After_Elaboration) := True;
+           (No_Standard_Allocators_After_Elaboration) := True;
       end if;
 
       --  Loop through all restriction violations

gcc/ada/gnatbind.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -143,7 +143,7 @@ procedure Gnatbind is
       --  should not be listed.
 
       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
-        (No_Allocators_After_Elaboration => True,
+        (No_Standard_Allocators_After_Elaboration => True,
          --  This involves run-time conditions not checkable at compile time
 
          No_Anonymous_Allocators         => True,

gcc/ada/restrict.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -68,6 +68,24 @@ package body Restrict is
    --  Set True if any entry of No_Specifcation_Of_Aspects has been set True.
    --  Once set True, this is never turned off again.
 
+   No_Use_Of_Attribute : array (Attribute_Id) of Source_Ptr :=
+                          (others => No_Location);
+
+   No_Use_Of_Attribute_Warning : array (Attribute_Id) of Boolean :=
+                                  (others => False);
+
+   No_Use_Of_Attribute_Set : Boolean := False;
+   --  Indicates that No_Use_Of_Attribute was set at least once.
+
+   No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr :=
+                        (others => No_Location);
+
+   No_Use_Of_Pragma_Warning : array (Pragma_Id) of Boolean :=
+                                  (others => False);
+
+   No_Use_Of_Pragma_Set : Boolean := False;
+   --  Indicates that No_Use_Of_Pragma was set at least once.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -287,6 +305,74 @@ package body Restrict is
       Check_Restriction (No_Implicit_Heap_Allocations, N);
    end Check_No_Implicit_Heap_Alloc;
 
+   -------------------------------------------
+   -- Check_Restriction_No_Use_Of_Attribute --
+   --------------------------------------------
+
+   procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
+      Id   : constant Name_Id      := Chars (N);
+      A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
+
+   begin
+      --  Ignore call if node N is not in the main source unit, since we only
+      --  give messages for the main unit. This avoids giving messages for
+      --  aspects that are specified in withed units.
+
+      if not In_Extended_Main_Source_Unit (N) then
+         return;
+      end if;
+
+      --  If nothing set, nothing to check.
+
+      if not No_Use_Of_Attribute_Set then
+         return;
+      end if;
+
+      Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
+
+      if Error_Msg_Sloc /= No_Location then
+         Error_Msg_Node_1 := N;
+         Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
+         Error_Msg_N
+           ("<violation of restriction `No_Use_Of_Attribute '='> &`#",
+            N);
+      end if;
+   end Check_Restriction_No_Use_Of_Attribute;
+
+   ----------------------------------------
+   -- Check_Restriction_No_Use_Of_Pragma --
+   ----------------------------------------
+
+   procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
+      Id   : constant Node_Id   := Pragma_Identifier (N);
+      P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
+
+   begin
+      --  Ignore call if node N is not in the main source unit, since we only
+      --  give messages for the main unit. This avoids giving messages for
+      --  aspects that are specified in withed units.
+
+      if not In_Extended_Main_Source_Unit (N) then
+         return;
+      end if;
+
+      --  If nothing set, nothing to check.
+
+      if not No_Use_Of_Pragma_Set then
+         return;
+      end if;
+
+      Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
+
+      if Error_Msg_Sloc /= No_Location then
+         Error_Msg_Node_1 := Id;
+         Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
+         Error_Msg_N
+           ("<violation of restriction `No_Use_Of_Pragma '='> &`#",
+            Id);
+      end if;
+   end Check_Restriction_No_Use_Of_Pragma;
+
    -----------------------------------
    -- Check_Obsolescent_2005_Entity --
    -----------------------------------
@@ -1271,6 +1357,44 @@ package body Restrict is
       No_Specification_Of_Aspect_Set := True;
    end Set_Restriction_No_Specification_Of_Aspect;
 
+   -----------------------------------------
+   -- Set_Restriction_No_Use_Of_Attribute --
+   -----------------------------------------
+
+   procedure Set_Restriction_No_Use_Of_Attribute
+     (N       : Node_Id;
+      Warning : Boolean)
+   is
+      A_Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
+
+   begin
+      No_Use_Of_Attribute_Set := True;
+      No_Use_Of_Attribute (A_Id) := Sloc (N);
+
+      if Warning = False then
+         No_Use_Of_Attribute_Warning (A_Id) := False;
+      end if;
+   end Set_Restriction_No_Use_Of_Attribute;
+
+   --------------------------------------
+   -- Set_Restriction_No_Use_Of_Pragma --
+   --------------------------------------
+
+   procedure Set_Restriction_No_Use_Of_Pragma
+     (N       : Node_Id;
+      Warning : Boolean)
+   is
+      A_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N));
+
+   begin
+      No_Use_Of_Pragma_Set := True;
+      No_Use_Of_Pragma (A_Id) := Sloc (N);
+
+      if Warning = False then
+         No_Use_Of_Pragma_Warning (A_Id) := False;
+      end if;
+   end Set_Restriction_No_Use_Of_Pragma;
+
    ----------------------------------
    -- Suppress_Restriction_Message --
    ----------------------------------

gcc/ada/restrict.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -252,6 +252,16 @@ package Restrict is
    --  Wrapper on Check_Restriction with Msg_Issued, with the out-parameter
    --  being ignored here.
 
+   procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id);
+   --  N is the node of an attribute definition clause.  An error message
+   --  (warning) will be issued if a restriction (warning) was previously set
+   --  for this attribute using Set_No_Use_Of_Attribute.
+
+   procedure Check_Restriction_No_Use_Of_Pragma  (N : Node_Id);
+   --  N is the node of a pragma.  An error message (warning) will be issued
+   --  if a restriction (warning) was previously set for this pragma using
+   --  Set_No_Use_Of_Pragma.
+
    procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id);
    --  Called when a dependence on a unit is created (either implicitly, or by
    --  an explicit WITH clause). U is a node for the unit involved, and Err is
@@ -416,6 +426,19 @@ package Restrict is
    --  case of a Restriction_Warnings pragma specifying this restriction and
    --  False for a Restrictions pragma specifying this restriction.
 
+   procedure Set_Restriction_No_Use_Of_Attribute
+     (N       : Node_Id;
+      Warning : Boolean);
+   --  N is the node id for the identifier in a pragma Restrictions for
+   --  No_Use_Of_Attribute. Caller has verified that this is a valid attribute
+   --  designator.
+
+   procedure Set_Restriction_No_Use_Of_Pragma
+     (N       : Node_Id;
+      Warning : Boolean);
+   --  N is the node id for the identifier in a pragma Restrictions for
+   --  No_Use_Of_Pragma. Caller has verified that this is a valid pragma id.
+
    function Tasking_Allowed return Boolean;
    pragma Inline (Tasking_Allowed);
    --  Tests if tasking operations are allowed by the current restrictions

gcc/ada/sem_ch13.adb

@@ -2770,6 +2770,7 @@ package body Sem_Ch13 is
       end if;
 
       Set_Entity (N, U_Ent);
+      Check_Restriction_No_Use_Of_Attribute (N);
 
       --  Switch on particular attribute
 

gcc/ada/sem_ch4.adb

@@ -413,8 +413,9 @@ package body Sem_Ch4 is
       if Comes_From_Source (N) then
          Check_Restriction (No_Allocators, N);
 
-         --  Processing for No_Allocators_After_Elaboration, loop to look at
-         --  enclosing context, checking task case and main subprogram case.
+         --  Processing for No_Standard_Allocators_After_Elaboration, loop to
+         --  look at enclosing context, checking task case and main subprogram
+         --  case.
 
          C := N;
          P := Parent (C);
@@ -431,7 +432,8 @@ package body Sem_Ch4 is
                --  violation of No_Allocators_After_Elaboration we can detect.
 
                if Nkind (Original_Node (Parent (P))) = N_Task_Body then
-                  Check_Restriction (No_Allocators_After_Elaboration, N);
+                  Check_Restriction
+                    (No_Standard_Allocators_After_Elaboration, N);
                   exit;
                end if;
 

gcc/ada/sem_prag.adb

@@ -5801,6 +5801,26 @@ package body Sem_Prag is
                   end if;
                end;
 
+            elsif Id = Name_No_Use_Of_Attribute then
+               if Nkind (Expr) /= N_Identifier
+                 or else not Is_Attribute_Name (Chars (Expr))
+               then
+                  Error_Msg_N ("unknown attribute name?", Expr);
+
+               else
+                  Set_Restriction_No_Use_Of_Attribute (Expr, Warn);
+               end if;
+
+            elsif Id = Name_No_Use_Of_Pragma then
+               if Nkind (Expr) /= N_Identifier
+                 or else not Is_Pragma_Name (Chars (Expr))
+               then
+                  Error_Msg_N ("unknown pragma name?", Expr);
+
+               else
+                  Set_Restriction_No_Use_Of_Pragma (Expr, Warn);
+               end if;
+
             --  All other cases of restriction identifier present
 
             else
@@ -6757,6 +6777,8 @@ package body Sem_Prag is
          end if;
       end if;
 
+      Check_Restriction_No_Use_Of_Pragma (N);
+
       --  An enumeration type defines the pragmas that are supported by the
       --  implementation. Get_Pragma_Id (in package Prag) transforms a name
       --  into the corresponding enumeration value for the following case.

gcc/ada/sem_res.adb

@@ -3667,6 +3667,10 @@ package body Sem_Res is
                         Establish_Transient_Scope (A, False);
                      end if;
                   end;
+
+                  if Ekind (Etype (F)) = E_Anonymous_Access_Type then
+                     Check_Restriction (No_Access_Parameter_Allocators, A);
+                  end if;
                end if;
 
                --  (Ada 2005): The call may be to a primitive operation of
@@ -4552,6 +4556,8 @@ package body Sem_Res is
                          Defining_Identifier (Associated_Node_For_Itype (Typ));
 
             begin
+               Check_Restriction (No_Coextensions, N);
+
                --  Ada 2012 AI05-0052: If the designated type of the allocator
                --  is limited, then the allocator shall not be used to define
                --  the value of an access discriminant unless the discriminated

gcc/ada/snames.ads-tmpl

@@ -721,6 +721,8 @@ package Snames is
    Name_Name                           : constant Name_Id := N + $;
    Name_NCA                            : constant Name_Id := N + $;
    Name_No                             : constant Name_Id := N + $;
+   Name_No_Access_Parameter_Allocators : constant Name_Id := N + $;
+   Name_No_Coextensions                : 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 + $;
@@ -728,8 +730,11 @@ package Snames is
    Name_No_Requeue                     : constant Name_Id := N + $;
    Name_No_Requeue_Statements          : constant Name_Id := N + $;
    Name_No_Specification_Of_Aspect     : constant Name_Id := N + $;
+   Name_No_Standard_Allocators_After_Elaboration : constant Name_Id := N + $;
    Name_No_Task_Attributes             : constant Name_Id := N + $;
    Name_No_Task_Attributes_Package     : constant Name_Id := N + $;
+   Name_No_Use_Of_Attribute            : constant Name_Id := N + $;
+   Name_No_Use_Of_Pragma               : constant Name_Id := N + $;
    Name_No_Unroll                      : constant Name_Id := N + $;
    Name_No_Vector                      : constant Name_Id := N + $;
    Name_Nominal                        : constant Name_Id := N + $;