par-ch2.adb (P_Expression_Or_Reserved_Word): New routine.

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch2.adb (P_Expression_Or_Reserved_Word): New routine.
	(P_Pragma): Signal Scan_Pragma_Argument_Association when the use
	of reserved words is OK.
	(Scan_Pragma_Argument_Association):
	Add new formal Reserved_Words_OK and update the comment on
	usage. Code cleanup. Parse an expression or a reserved word in
	identifier form for pragmas Restriction_Warnings and Restrictions
	No_Use_Of_Attribute.
	* restrict.adb (Check_Restriction_No_Use_Of_Attribute):
	Reimplemented.	(Check_Restriction_No_Use_Of_Pragma): Code cleanup.
	(Set_Restriction_No_Specification_Of_Aspect): Properly set the warning
	flag for an aspect.
	(Set_Restriction_No_Use_Of_Attribute): Properly set the warning
	flag for an attribute.	(Set_Restriction_No_Use_Of_Entity):
	Update the parameter profile.
	(Set_Restriction_No_Use_Of_Pragma): Properly set the warning flag for
	a pragma.
	* restrict.ads (Check_Restriction_No_Use_Of_Attribute): Update
	the comment on usage.
	(Set_Restriction_No_Use_Of_Entity): Update the parameter profile.
	* sem_attr.adb (Analyze_Attribute): Check restriction
	No_Use_Of_Attribute.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
	restriction No_Use_Of_Attribute before any rewritings have
	taken place.
	* sem_prag.adb (Analyze_Pragma): Check restriction
	No_Use_Of_Pragma before any rewritings have taken place.

From-SVN: r235134

gcc/ada/ChangeLog

+2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* par-ch2.adb (P_Expression_Or_Reserved_Word): New routine.
+	(P_Pragma): Signal Scan_Pragma_Argument_Association when the use
+	of reserved words is OK.
+	(Scan_Pragma_Argument_Association):
+	Add new formal Reserved_Words_OK and update the comment on
+	usage. Code cleanup. Parse an expression or a reserved word in
+	identifier form for pragmas Restriction_Warnings and Restrictions
+	No_Use_Of_Attribute.
+	* restrict.adb (Check_Restriction_No_Use_Of_Attribute):
+	Reimplemented.	(Check_Restriction_No_Use_Of_Pragma): Code cleanup.
+	(Set_Restriction_No_Specification_Of_Aspect): Properly set the warning
+	flag for an aspect.
+	(Set_Restriction_No_Use_Of_Attribute): Properly set the warning
+	flag for an attribute.	(Set_Restriction_No_Use_Of_Entity):
+	Update the parameter profile.
+	(Set_Restriction_No_Use_Of_Pragma): Properly set the warning flag for
+	a pragma.
+	* restrict.ads (Check_Restriction_No_Use_Of_Attribute): Update
+	the comment on usage.
+	(Set_Restriction_No_Use_Of_Entity): Update the parameter profile.
+	* sem_attr.adb (Analyze_Attribute): Check restriction
+	No_Use_Of_Attribute.
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Check
+	restriction No_Use_Of_Attribute before any rewritings have
+	taken place.
+	* sem_prag.adb (Analyze_Pragma): Check restriction
+	No_Use_Of_Pragma before any rewritings have taken place.
+
 2016-04-18  Bob Duff  <duff@adacore.com>
 
 	* sem_ch6.adb (Is_Inline_Pragma): The pragma

gcc/ada/par-ch2.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -33,13 +33,16 @@ package body Ch2 is
    --  Local functions, used only in this chapter
 
    procedure Scan_Pragma_Argument_Association
-     (Identifier_Seen : in out Boolean;
-      Association     : out Node_Id);
-   --  Scans out a pragma argument association. Identifier_Seen is true on
-   --  entry if a previous association had an identifier, and gets set True if
-   --  the scanned association has an identifier (this is used to check the
+     (Identifier_Seen   : in out Boolean;
+      Association       : out Node_Id;
+      Reserved_Words_OK : Boolean := False);
+   --  Scans out a pragma argument association. Identifier_Seen is True on
+   --  entry if a previous association had an identifier, and gets set True
+   --  if the scanned association has an identifier (this is used to check the
    --  rule that no associations without identifiers can follow an association
-   --  which has an identifier). The result is returned in Association.
+   --  which has an identifier). The result is returned in Association. Flag
+   --  For_Pragma_Restrictions should be set when arguments are being parsed
+   --  for pragma Restrictions.
    --
    --  Note: We allow attribute forms Pre'Class, Post'Class, Invariant'Class,
    --  Type_Invariant'Class in place of a pragma argument identifier. Rather
@@ -279,8 +282,8 @@ package body Ch2 is
       if Ada_Version >= Ada_2005
         and then Token = Tok_Interface
       then
-         Prag_Name := Name_Interface;
-         Ident_Node  := Make_Identifier (Token_Ptr, Name_Interface);
+         Prag_Name  := Name_Interface;
+         Ident_Node := Make_Identifier (Token_Ptr, Name_Interface);
          Scan; -- past INTERFACE
       else
          Ident_Node := P_Identifier;
@@ -317,7 +320,13 @@ package body Ch2 is
 
          loop
             Arg_Count := Arg_Count + 1;
-            Scan_Pragma_Argument_Association (Identifier_Seen, Assoc_Node);
+
+            Scan_Pragma_Argument_Association
+              (Identifier_Seen   => Identifier_Seen,
+               Association       => Assoc_Node,
+               Reserved_Words_OK =>
+                 Nam_In (Prag_Name, Name_Restriction_Warnings,
+                                    Name_Restrictions));
 
             if Arg_Count = 2
               and then (Interface_Check_Required or else Import_Check_Required)
@@ -476,17 +485,73 @@ package body Ch2 is
    --  Error recovery: cannot raise Error_Resync
 
    procedure Scan_Pragma_Argument_Association
-     (Identifier_Seen : in out Boolean;
-      Association     : out Node_Id)
+     (Identifier_Seen   : in out Boolean;
+      Association       : out Node_Id;
+      Reserved_Words_OK : Boolean := False)
    is
-      Scan_State      : Saved_Scan_State;
+      function P_Expression_Or_Reserved_Word return Node_Id;
+      --  Parse an expression or if the token denotes one of the following
+      --  reserved words, construct an identifier with proper Chars field.
+      --    Access
+      --    Delta
+      --    Digits
+      --    Mod
+      --    Range
+
+      -----------------------------------
+      -- P_Expression_Or_Reserved_Word --
+      -----------------------------------
+
+      function P_Expression_Or_Reserved_Word return Node_Id is
+         Word    : Node_Id;
+         Word_Id : Name_Id;
+
+      begin
+         Word_Id := No_Name;
+
+         if Token = Tok_Access then
+            Word_Id := Name_Access;
+            Scan; -- past ACCESS
+
+         elsif Token = Tok_Delta then
+            Word_Id := Name_Delta;
+            Scan; -- past DELTA
+
+         elsif Token = Tok_Digits then
+            Word_Id := Name_Digits;
+            Scan; -- past DIGITS
+
+         elsif Token = Tok_Mod then
+            Word_Id := Name_Mod;
+            Scan; -- past MOD
+
+         elsif Token = Tok_Range then
+            Word_Id := Name_Range;
+            Scan; -- post RANGE
+         end if;
+
+         if Word_Id = No_Name then
+            return P_Expression;
+         else
+            Word := New_Node (N_Identifier, Token_Ptr);
+            Set_Chars (Word, Word_Id);
+            return Word;
+         end if;
+      end P_Expression_Or_Reserved_Word;
+
+      --  Local variables
+
+      Expression_Node : Node_Id;
       Identifier_Node : Node_Id;
-      Id_Present      : Boolean;
+      Identifier_OK   : Boolean;
+      Scan_State      : Saved_Scan_State;
+
+   --  Start of processing for Scan_Pragma_Argument_Association
 
    begin
       Association := New_Node (N_Pragma_Argument_Association, Token_Ptr);
       Set_Chars (Association, No_Name);
-      Id_Present := False;
+      Identifier_OK := False;
 
       --  Argument starts with identifier
 
@@ -497,7 +562,7 @@ package body Ch2 is
 
          if Token = Tok_Arrow then
             Scan; -- past arrow
-            Id_Present := True;
+            Identifier_OK := True;
 
          --  Case of one of the special aspect forms
 
@@ -520,7 +585,7 @@ package body Ch2 is
                --  Here we have scanned identifier'Class =>
 
                else
-                  Id_Present := True;
+                  Identifier_OK := True;
                   Scan; -- past arrow
 
                   case Chars (Identifier_Node) is
@@ -550,7 +615,7 @@ package body Ch2 is
 
          --  Identifier was present
 
-         if Id_Present then
+         if Identifier_OK then
             Set_Chars (Association, Chars (Identifier_Node));
             Identifier_Seen := True;
 
@@ -569,16 +634,32 @@ package body Ch2 is
       --  message in Relaxed_RM_Semantics mode to help legacy code using e.g.
       --  codepeer.
 
-      if Identifier_Seen and not Id_Present and not Relaxed_RM_Semantics then
+      if Identifier_Seen
+        and not Identifier_OK
+        and not Relaxed_RM_Semantics
+      then
          Error_Msg_SC ("|pragma argument identifier required here");
          Error_Msg_SC ("\since previous argument had identifier (RM 2.8(4))");
       end if;
 
-      if Id_Present then
-         Set_Expression (Association, P_Expression);
+      if Identifier_OK then
+
+         --  Certain pragmas such as Restriction_Warninds and Restrictions
+         --  allow reserved words to appear as expressions when checking for
+         --  prohibited uses of attributes.
+
+         if Reserved_Words_OK
+           and then Chars (Identifier_Node) = Name_No_Use_Of_Attribute
+         then
+            Expression_Node := P_Expression_Or_Reserved_Word;
+         else
+            Expression_Node := P_Expression;
+         end if;
       else
-         Set_Expression (Association, P_Expression_If_OK);
+         Expression_Node := P_Expression_If_OK;
       end if;
+
+      Set_Expression (Association, Expression_Node);
    end Scan_Pragma_Argument_Association;
 
 end Ch2;

gcc/ada/restrict.ads

@@ -287,9 +287,9 @@ package Restrict is
    --  for this aspect using Set_No_Specification_Of_Aspect.
 
    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.
+   --  N denotes an attribute definition clause or an attribute reference. 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_Entity (N : Node_Id);
    --  N is the node id for an entity reference. An error message (warning)
@@ -316,7 +316,10 @@ package Restrict is
    --  the SPARK_05 restriction is set, then an error is issued on N. Msg
    --  is appended to the restriction failure message.
 
-   procedure Check_SPARK_05_Restriction (Msg1, Msg2 : String; N : Node_Id);
+   procedure Check_SPARK_05_Restriction
+     (Msg1 : String;
+      Msg2 : String;
+      N    : Node_Id);
    --  Same as Check_SPARK_05_Restriction except there is a continuation
    --  message Msg2 following the initial message Msg1.
 
@@ -490,7 +493,7 @@ package Restrict is
 
    procedure Set_Restriction_No_Use_Of_Entity
      (Entity  : Node_Id;
-      Warn    : Boolean;
+      Warning : Boolean;
       Profile : Profile_Name := No_Profile);
    --  Sets given No_Use_Of_Entity restriction in table if not there already.
    --  Warn is True if from Restriction_Warnings, or for Restrictions if the

gcc/ada/sem_attr.adb

@@ -2624,13 +2624,15 @@ package body Sem_Attr is
    --  Start of processing for Analyze_Attribute
 
    begin
-      --  Immediate return if unrecognized attribute (already diagnosed
-      --  by parser, so there is nothing more that we need to do)
+      --  Immediate return if unrecognized attribute (already diagnosed by
+      --  parser, so there is nothing more that we need to do).
 
       if not Is_Attribute_Name (Aname) then
          raise Bad_Attribute;
       end if;
 
+      Check_Restriction_No_Use_Of_Attribute (N);
+
       --  Deal with Ada 83 issues
 
       if Comes_From_Source (N) then

gcc/ada/sem_ch13.adb

@@ -4395,6 +4395,8 @@ package body Sem_Ch13 is
          Set_Analyzed (N, True);
       end if;
 
+      Check_Restriction_No_Use_Of_Attribute (N);
+
       --  Ignore some selected attributes in CodePeer mode since they are not
       --  relevant in this context.
 
@@ -4580,7 +4582,6 @@ 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_prag.adb

@@ -10046,6 +10046,8 @@ package body Sem_Prag is
          Set_Analyzed (N);
       end if;
 
+      Check_Restriction_No_Use_Of_Pragma (N);
+
       --  Deal with unrecognized pragma
 
       Pname := Pragma_Name (N);
@@ -10149,8 +10151,6 @@ 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.