sem.adb, sem.ads (In_Default_Expr): Global flag that is set to True during analysis...

2014-08-04  Yannick Moy  <moy@adacore.com>

	* sem.adb, sem.ads (In_Default_Expr): Global flag that is set
	to True during analysis of a default component expression.
	(Semantics): Save and restore In_Default_Expr around analysis.
	* sem_ch3.adb, sem_ch3.ads (Analyze_Component_Declaration):
	Call new wrapper Preanalyze_Default_Expression.
	(Preanalyze_Default_Expression): New wrapper on
	Preanalyze_Spec_Expression which sets and restores In_Default_Expr.
	* sem_res.adb (Resolve_Call): Mark calls inside default
	expressions as not inlined in GNATprove mode.

From-SVN: r213536

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ed625f2a3e0de6bb574dfa4220667198eee4a4f0..94426168802e001ec8b19cdbdd7ab91fd2462244 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-08-04  Yannick Moy  <moy@adacore.com>
+
+       * sem.adb, sem.ads (In_Default_Expr): Global flag that is set
+       to True during analysis of a default component expression.
+       (Semantics): Save and restore In_Default_Expr around analysis.
+       * sem_ch3.adb, sem_ch3.ads (Analyze_Component_Declaration):
+       Call new wrapper Preanalyze_Default_Expression.
+       (Preanalyze_Default_Expression): New wrapper on
+       Preanalyze_Spec_Expression which sets and restores In_Default_Expr.
+       * sem_res.adb (Resolve_Call): Mark calls inside default
+       expressions as not inlined in GNATprove mode.
+
 2014-08-04  Robert Dewar  <dewar@adacore.com>
 
        * exp_ch4.adb: Minor reformatting.

diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 73f345e99896bc8e4f6c1df273522bce87828b45..f1dd366573187381f3afc1c1e1f9a7f720365df7 100644 (file)
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1309,6 +1309,7 @@ package body Sem is
       S_GNAT_Mode         : constant Boolean          := GNAT_Mode;
       S_Global_Dis_Names  : constant Boolean          := Global_Discard_Names;
       S_In_Assertion_Expr : constant Nat              := In_Assertion_Expr;
+      S_In_Default_Expr   : constant Boolean          := In_Default_Expr;
       S_In_Spec_Expr      : constant Boolean          := In_Spec_Expression;
       S_Inside_A_Generic  : constant Boolean          := Inside_A_Generic;
       S_Outer_Gen_Scope   : constant Entity_Id        := Outer_Generic_Scope;
@@ -1442,6 +1443,7 @@ package body Sem is
       Full_Analysis      := True;
       Inside_A_Generic   := False;
       In_Assertion_Expr  := 0;
+      In_Default_Expr    := False;
       In_Spec_Expression := False;
       Set_Comes_From_Source_Default (False);
 
@@ -1525,6 +1527,7 @@ package body Sem is
       Global_Discard_Names := S_Global_Dis_Names;
       GNAT_Mode            := S_GNAT_Mode;
       In_Assertion_Expr    := S_In_Assertion_Expr;
+      In_Default_Expr      := S_In_Default_Expr;
       In_Spec_Expression   := S_In_Spec_Expr;
       Inside_A_Generic     := S_Inside_A_Generic;
       Outer_Generic_Scope  := S_Outer_Gen_Scope;

diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 13fc485f9bdc80ecd66cc8702c7f350b82965444..fced1255aab2bf2af7aeefd2d5a8889c234c87b9 100644 (file)
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -245,12 +245,18 @@ package Sem is
 
    In_Assertion_Expr : Nat := 0;
    --  This is set non-zero if we are within the expression of an assertion
-   --  pragma or aspect. It is a counter which is incremented at the start
-   --  of expanding such an expression, and decremented on completion of
-   --  expanding that expression. Probably a boolean would be good enough,
-   --  since we think that such expressions cannot nest, but that might not
-   --  be true in the future (e.g. if let expressions are added to Ada) so
-   --  we prepare for that future possibility by making it a counter.
+   --  pragma or aspect. It is a counter which is incremented at the start of
+   --  expanding such an expression, and decremented on completion of expanding
+   --  that expression. Probably a boolean would be good enough, since we think
+   --  that such expressions cannot nest, but that might not be true in the
+   --  future (e.g. if let expressions are added to Ada) so we prepare for that
+   --  future possibility by making it a counter. Like In_Spec_Expression, it
+   --  must be recursively saved on a Semantics call.
+
+   In_Default_Expr : Boolean := False;
+   --  Switch to indicate that we are analyzing a default component expression.
+   --  Like In_Spec_Expression, it must be recursively saved on a Semantics
+   --  call.
 
    In_Inlined_Body : Boolean := False;
    --  Switch to indicate that we are analyzing and resolving an inlined body.

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f4983035fd109ae97999387942c6b716b2a7239a..0a53fd8f442a5d746bf0846073d9183aa339e77e 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1938,7 +1938,7 @@ package body Sem_Ch3 is
 
       if Present (E) then
          Check_SPARK_Restriction ("default expression is not allowed", E);
-         Preanalyze_Spec_Expression (E, T);
+         Preanalyze_Default_Expression (E, T);
          Check_Initialization (T, E);
 
          if Ada_Version >= Ada_2005
@@ -20215,6 +20215,18 @@ package body Sem_Ch3 is
       In_Assertion_Expr := In_Assertion_Expr - 1;
    end Preanalyze_Assert_Expression;
 
+   -----------------------------------
+   -- Preanalyze_Default_Expression --
+   -----------------------------------
+
+   procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id) is
+      Save_In_Default_Expr : constant Boolean := In_Default_Expr;
+   begin
+      In_Default_Expr := True;
+      Preanalyze_Spec_Expression (N, T);
+      In_Default_Expr := Save_In_Default_Expr;
+   end Preanalyze_Default_Expression;
+
    --------------------------------
    -- Preanalyze_Spec_Expression --
    --------------------------------

diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index a90485697616920af722d1a0b6c4a8eccbcb7824..57184ed58ad2e6c50981f8b203b26369a267d137 100644 (file)
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -250,6 +250,10 @@ package Sem_Ch3 is
    --  Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that
    --  In_Assertion_Expr can be properly adjusted.
 
+   procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id);
+   --  Wrapper on Preanalyze_Spec_Expression for default expressions, so that
+   --  In_Default_Expr can be properly adjusted.
+
    procedure Process_Full_View (N : Node_Id; Full_T, Priv_T : Entity_Id);
    --  Process some semantic actions when the full view of a private type is
    --  encountered and analyzed. The first action is to create the full views

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9509b230860c88fd619ab9cb1bbe180e1e4d89f9..22e6fd633266d365bb2f231f1a2bdbbf9272ee2c 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6245,6 +6245,13 @@ package body Sem_Res is
                Error_Msg_N ("\call appears in assertion expression", N);
                Set_Is_Inlined_Always (Nam_UA, False);
 
+            --  Calls cannot be inlined inside default expressions
+
+            elsif In_Default_Expr then
+               Error_Msg_NE ("?no contextual analysis of &", N, Nam);
+               Error_Msg_N ("\call appears in default expression", N);
+               Set_Is_Inlined_Always (Nam_UA, False);
+
             --  Inlining should not be performed during pre-analysis
 
             elsif Full_Analysis then