2014-07-29 Ed Schonberg <schonberg@adacore.com>

	* inline.ads, inline.adb, sem_ch10.adb: Rename Check_Body_For_Inlining
	to Check_Package_Body_For_Inlining, to prevent confusion with other
	inlining subprograms.

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

	* opt.ads: Minor comment update.
	* sem_attr.adb (Uneval_Old_Msg): Deal with case of aspect, where
	we want setting of Uneval_Old at time of encountering the aspect.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Capture setting
	of Opt.Uneval_Old.
	* sinfo.adb (Uneval_Old_Accept): New function (Uneval_Old_Warn):
	New function (Set_Uneval_Old_Accept): New procedure.
	(Set_Uneval_Old_Warn): New procedure.
	* sinfo.ads: Uneval_Old_Accept: New flag Uneval_Old_Warn: New flag.



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

9 files changed, 149 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1543bdc167a..5a21a5cc62c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* inline.ads, inline.adb, sem_ch10.adb: Rename Check_Body_For_Inlining
+	to Check_Package_Body_For_Inlining, to prevent confusion with other
+	inlining subprograms.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+	* opt.ads: Minor comment update.
+	* sem_attr.adb (Uneval_Old_Msg): Deal with case of aspect, where
+	we want setting of Uneval_Old at time of encountering the aspect.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Capture setting
+	of Opt.Uneval_Old.
+	* sinfo.adb (Uneval_Old_Accept): New function (Uneval_Old_Warn):
+	New function (Set_Uneval_Old_Accept): New procedure.
+	(Set_Uneval_Old_Warn): New procedure.
+	* sinfo.ads: Uneval_Old_Accept: New flag Uneval_Old_Warn: New flag.
+
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
 	* sinfo.ads, inline.adb, inline.ads, sem_ch6.adb: Minor reformatting.
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 2dc8be7359c..a27c4a29780 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -2559,11 +2559,11 @@ package body Inline is
       end if;
    end Check_And_Build_Body_To_Inline;
 
-   -----------------------------
-   -- Check_Body_For_Inlining --
-   -----------------------------
+   -------------------------------------
+   -- Check_Package_Body_For_Inlining --
+   -------------------------------------
 
-   procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
+   procedure Check_Package_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
       Bname : Unit_Name_Type;
       E     : Entity_Id;
       OK    : Boolean;
@@ -2667,7 +2667,7 @@ package body Inline is
             Next_Entity (E);
          end loop;
       end if;
-   end Check_Body_For_Inlining;
+   end Check_Package_Body_For_Inlining;
 
    --------------------
    -- Cleanup_Scopes --
diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads
index 4c1dbf92fe9..e8b1c0134de 100644
--- a/gcc/ada/inline.ads
+++ b/gcc/ada/inline.ads
@@ -162,10 +162,11 @@ package Inline is
    --  If a subprogram has pragma Inline and inlining is active, use generic
    --  machinery to build an unexpanded body for the subprogram. This body is
    --  subsequently used for inline expansions at call sites. If subprogram can
-   --  be inlined (depending on size and nature of local declarations) this
-   --  function returns true. Otherwise subprogram body is treated normally.
-   --  If proper warnings are enabled and the subprogram contains a construct
-   --  that cannot be inlined, the offending construct is flagged accordingly.
+   --  be inlined (depending on size and nature of local declarations) the
+   --  template body is created. Otherwise subprogram body is treated normally
+   --  and calls are not inlined in the frontend.  If proper warnings are
+   --  enabled and the subprogram contains a construct that cannot be inlined,
+   --  the problematic construct is flagged accordingly.
 
    procedure Cannot_Inline
      (Msg        : String;
@@ -209,7 +210,7 @@ package Inline is
    --  cases documented in Check_Body_To_Inline) then build the body-to-inline
    --  associated with N and attach it to the declaration node of Spec_Id.
 
-   procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id);
+   procedure Check_Package_Body_For_Inlining (N : Node_Id; P : Entity_Id);
    --  If front-end inlining is enabled and a package declaration contains
    --  inlined subprograms, load and compile the package body to collect the
    --  bodies of these subprograms, so they are available to inline calls.
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index ba28fe31e86..d5de7980d77 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1495,7 +1495,8 @@ package Opt is
    Uneval_Old : Character := 'E';
    --  GNAT
    --  Set to 'E'/'W'/'A' for use of Error/Warn/Allow in a valid pragma
-   --  Unevaluated_Use_Of_Old.
+   --  Unevaluated_Use_Of_Old. Default in the absence of the pragma is 'E'
+   --  for the RM default behavior of giving an error.
 
    Unique_Error_Tag : Boolean := Tag_Errors;
    --  GNAT
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 09ab6075662..6c3b72df87e 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -412,7 +412,8 @@ package body Sem_Attr is
       procedure Uneval_Old_Msg;
       --  Called when Loop_Entry or Old is used in a potentially unevaluated
       --  expression. Generates appropriate message or warning depending on
-      --  the setting of Opt.Uneval_Old.
+      --  the setting of Opt.Uneval_Old (or flags in an N_Aspect_Specification
+      --  node in the aspect case).
 
       procedure Unexpected_Argument (En : Node_Id);
       --  Signal unexpected attribute argument (En is the argument)
@@ -2275,8 +2276,40 @@ package body Sem_Attr is
       --------------------
 
       procedure Uneval_Old_Msg is
+         Uneval_Old_Setting : Character := Opt.Uneval_Old;
+         Prag               : Node_Id;
+
       begin
-         case Uneval_Old is
+         --  If from aspect, then Uneval_Old_Setting comes from flags in the
+         --  N_Aspect_Specification node that corresponds to the attribute.
+
+         --  First find the pragma in which we appear (note that at this stage,
+         --  even if we appeared originally within an aspect specification, we
+         --  are now within the corresponding pragma).
+
+         Prag := N;
+         loop
+            Prag := Parent (Prag);
+            exit when No (Prag) or else Nkind (Prag) = N_Pragma;
+         end loop;
+
+         --  If we did not find the pragma, that's odd, just consider it a
+         --  case where we use Opt.Uneval_Old for further processing. Perhaps
+         --  this can come from some previous error.
+
+         if Present (Prag) and then From_Aspect_Specification (Prag) then
+            if Uneval_Old_Accept (Corresponding_Aspect (Prag)) then
+               Uneval_Old_Setting := 'A';
+            elsif Uneval_Old_Warn (Corresponding_Aspect (Prag)) then
+               Uneval_Old_Setting := 'W';
+            else
+               Uneval_Old_Setting := 'E';
+            end if;
+         end if;
+
+         --  Processing depends on the setting of Uneval_Old
+
+         case Uneval_Old_Setting is
             when 'E' =>
                Error_Attr_P
                  ("prefix of attribute % that is potentially "
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 8330c427da1..a8e0078c1f2 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1209,7 +1209,7 @@ package body Sem_Ch10 is
             Save_Style_Check_Options (Options);
             Reset_Style_Check_Options;
             Opt.Warning_Mode := Suppress;
-            Check_Body_For_Inlining (N, Defining_Entity (Unit_Node));
+            Check_Package_Body_For_Inlining (N, Defining_Entity (Unit_Node));
 
             Reset_Style_Check_Options;
             Set_Style_Check_Options (Options);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index fc09f6f3d08..f1a9f1004d1 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1544,6 +1544,19 @@ package body Sem_Ch13 is
             Set_Entity (Aspect, E);
             Ent := New_Occurrence_Of (E, Sloc (Id));
 
+            --  Capture setting of Opt.Uneval_Old
+
+            case Opt.Uneval_Old is
+               when 'A' =>
+                  Set_Uneval_Old_Accept (Aspect);
+               when 'E' =>
+                  null;
+               when 'W' =>
+                  Set_Uneval_Old_Warn (Aspect);
+               when others =>
+                  raise Program_Error;
+            end case;
+
             --  Check for duplicate aspect. Note that the Comes_From_Source
             --  test allows duplicate Pre/Post's that we generate internally
             --  to escape being flagged here.
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 3ea385c3877..aca92b390b5 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -3164,6 +3164,22 @@ package body Sinfo is
       return Node3 (N);
    end Type_Definition;
 
+   function Uneval_Old_Accept
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      return Flag13 (N);
+   end Uneval_Old_Accept;
+
+   function Uneval_Old_Warn
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      return Flag18 (N);
+   end Uneval_Old_Warn;
+
    function Unit
       (N : Node_Id) return Node_Id is
    begin
@@ -6347,6 +6363,22 @@ package body Sinfo is
       Set_Elist3 (N, Val); -- semantic field, no parent set
    end Set_TSS_Elist;
 
+   procedure Set_Uneval_Old_Accept
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      Set_Flag13 (N, Val);
+   end Set_Uneval_Old_Accept;
+
+   procedure Set_Uneval_Old_Warn
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      Set_Flag18 (N, Val);
+   end Set_Uneval_Old_Warn;
+
    procedure Set_Type_Definition
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 5c085410571..6f5b2a94440 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2090,6 +2090,21 @@ package Sinfo is
    --    if there are no type support subprograms for the type or if the freeze
    --    node is not for a type.
 
+   --  Uneval_Old_Accept (Flag13-Sem)
+   --    Present in N_Aspect_Specification nodes. Set if Opt.Uneval_Old is set
+   --    to 'A' (accept) at the point where the aspect specification node is
+   --    encountered. It is this setting that is relevant, rather than the
+   --    setting at the point where a contract is finally analyzed after the
+   --    usual delay till the freeze point.
+
+   --  Uneval_Old_Warn (Flag18-Sem)
+   --    Present in N_Aspect_Specification nodes. Set if Opt.Uneval_Old is set
+   --    to 'W' (warn) at the point where the aspect specification node is
+   --    encountered. It is this setting that is relevant, rather than the
+   --    setting at the point where a contract is finally analyzed after the
+   --    usual delay till the freeze point. If neither Uneval_Old_Accept nor
+   --    Uneval_Old_Warn is set, then the default Error mode applies.
+
    --  Unreferenced_In_Spec (Flag7-Sem)
    --    Present in N_With_Clause nodes. Set if the with clause is on the
    --    package or subprogram spec where the main unit is the corresponding
@@ -7113,14 +7128,16 @@ package Sinfo is
       --  Aspect_Rep_Item (Node2-Sem)
       --  Expression (Node3) Aspect_Definition (set to Empty if none)
       --  Entity (Node4-Sem) entity to which the aspect applies
-      --  Class_Present (Flag6) Set if 'Class present
       --  Next_Rep_Item (Node5-Sem)
-      --  Split_PPC (Flag17) Set if split pre/post attribute
-      --  Is_Boolean_Aspect (Flag16-Sem)
+      --  Class_Present (Flag6) Set if 'Class present
+      --  Is_Ignored (Flag9-Sem)
       --  Is_Checked (Flag11-Sem)
+      --  Uneval_Old_Accept (Flag13-Sem)
       --  Is_Delayed_Aspect (Flag14-Sem)
       --  Is_Disabled (Flag15-Sem)
-      --  Is_Ignored (Flag9-Sem)
+      --  Is_Boolean_Aspect (Flag16-Sem)
+      --  Split_PPC (Flag17) Set if split pre/post attribute
+      --  Uneval_Old_Warn (Flag18-Sem)
 
       --  Note: Aspect_Specification is an Ada 2012 feature
 
@@ -9609,6 +9626,12 @@ package Sinfo is
    function Type_Definition
      (N : Node_Id) return Node_Id;    -- Node3
 
+   function Uneval_Old_Accept
+     (N : Node_Id) return Boolean;    -- Flag13
+
+   function Uneval_Old_Warn
+     (N : Node_Id) return Boolean;    -- Flag18
+
    function Unit
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -10626,6 +10649,12 @@ package Sinfo is
    procedure Set_Type_Definition
      (N : Node_Id; Val : Node_Id);            -- Node3
 
+   procedure Set_Uneval_Old_Accept
+     (N : Node_Id; Val : Boolean := True);    -- Flag13
+
+   procedure Set_Uneval_Old_Warn
+     (N : Node_Id; Val : Boolean := True);    -- Flag18
+
    procedure Set_Unit
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -12744,6 +12773,8 @@ package Sinfo is
    pragma Inline (Treat_Fixed_As_Integer);
    pragma Inline (TSS_Elist);
    pragma Inline (Type_Definition);
+   pragma Inline (Uneval_Old_Accept);
+   pragma Inline (Uneval_Old_Warn);
    pragma Inline (Unit);
    pragma Inline (Uninitialized_Variable);
    pragma Inline (Unknown_Discriminants_Present);
@@ -13077,6 +13108,8 @@ package Sinfo is
    pragma Inline (Set_Triggering_Alternative);
    pragma Inline (Set_Triggering_Statement);
    pragma Inline (Set_Type_Definition);
+   pragma Inline (Set_Uneval_Old_Accept);
+   pragma Inline (Set_Uneval_Old_Warn);
    pragma Inline (Set_Unit);
    pragma Inline (Set_Uninitialized_Variable);
    pragma Inline (Set_Unknown_Discriminants_Present);