[multiple changes]

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

	* sem_util.ads, sem_util.adb: Code cleanup for Is_Expression_Function
	(can apply to any scope entity).
	* sem_res.adb (Resolve_Call):  If the call is within another
	expression function it does not constitute a freeze point.

2013-04-23  Yannick Moy  <moy@adacore.com>

	* exp_ch6.adb (Expand_Actuals): Test that Subp
	is overloadable before testing if it's an inherited operation.

From-SVN: r198181

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 338038372b35f4d1598ff4c97a7cc7ff33e7ed16..3ff802fd64e64f0eb8e9aded263bf80bcf264cff 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2013-04-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_util.ads, sem_util.adb: Code cleanup for Is_Expression_Function
+       (can apply to any scope entity).
+       * sem_res.adb (Resolve_Call):  If the call is within another
+       expression function it does not constitute a freeze point.
+
+2013-04-23  Yannick Moy  <moy@adacore.com>
+
+       * exp_ch6.adb (Expand_Actuals): Test that Subp
+       is overloadable before testing if it's an inherited operation.
+
 2013-04-23  Robert Dewar  <dewar@adacore.com>
 
        * a-envvar.adb, a-envvar.ads, exp_util.adb, sem_ch12.adb: Minor

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 1be6d729ee22e9b6d16592a0c906314af62e9a1f..08e93c4a4a956081cf5b0384b257e818eeeca584 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1719,6 +1719,11 @@ package body Exp_Ch6 is
             --  subtype is elaborated before the body of the subprogram, but
             --  this is harder to verify, and there may be a redundant check.
 
+            --  Note also that Subp may be either a subprogram entity for
+            --  direct calls, or a type entity for indirect calls, hence the
+            --  test that Is_Overloadable returns True before testing whether
+            --  Subp is an inherited operation.
+
             if (Present (Find_Aspect (E_Actual, Aspect_Predicate))
                   or else
                 Present (Find_Aspect (E_Actual, Aspect_Dynamic_Predicate))
@@ -1727,6 +1732,7 @@ package body Exp_Ch6 is
               and then not Is_Init_Proc (Subp)
             then
                if (Is_Derived_Type (E_Actual)
+                    and then Is_Overloadable (Subp)
                     and then Is_Inherited_Operation_For_Type (Subp, E_Actual))
                  or else Is_Entity_Name (Actual)
                then

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 99fd9d52ab1f26c1a95fd455f2e28e7f695aa1f2..7d00399f52d28b0a3783bbbb7fd95a23cc4d4e5a 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5386,12 +5386,14 @@ package body Sem_Res is
 
       --  In Ada 2012, expression functions may be called within pre/post
       --  conditions of subsequent functions or expression functions. Such
-      --  calls do not freeze when they appear within generated bodies, which
-      --  would place the freeze node in the wrong scope.  An expression
-      --  function is frozen in the usual fashion, by the appearance of a real
-      --  body, or at the end of a declarative part.
+      --  calls do not freeze when they appear within generated bodies,
+      --  (including the body of another expression function) which would
+      --  place the freeze node in the wrong scope.  An expression function
+      --  is frozen in the usual fashion, by the appearance of a real body,
+      --  or at the end of a declarative part.
 
       if Is_Entity_Name (Subp) and then not In_Spec_Expression
+        and then not Is_Expression_Function (Current_Scope)
         and then
           (not Is_Expression_Function (Entity (Subp))
             or else Scope (Entity (Subp)) = Current_Scope)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ea4fe46125ae9915b074056fe8329041bde5b23f..172721d65190d6694e27264a3599b305a1810975 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8122,19 +8122,24 @@ package body Sem_Util is
    ----------------------------
 
    function Is_Expression_Function (Subp : Entity_Id) return Boolean is
-      Decl : constant Node_Id := Unit_Declaration_Node (Subp);
+      Decl : Node_Id;
 
    begin
-      return Ekind (Subp) = E_Function
-        and then Nkind (Decl) = N_Subprogram_Declaration
-        and then
-          (Nkind (Original_Node (Decl)) = N_Expression_Function
-            or else
-              (Present (Corresponding_Body (Decl))
-                and then
-                  Nkind (Original_Node
-                     (Unit_Declaration_Node (Corresponding_Body (Decl))))
-                 = N_Expression_Function));
+      if Ekind (Subp) /= E_Function then
+         return False;
+
+      else
+         Decl := Unit_Declaration_Node (Subp);
+         return Nkind (Decl) = N_Subprogram_Declaration
+           and then
+             (Nkind (Original_Node (Decl)) = N_Expression_Function
+               or else
+                 (Present (Corresponding_Body (Decl))
+                   and then
+                     Nkind (Original_Node
+                        (Unit_Declaration_Node (Corresponding_Body (Decl))))
+                    = N_Expression_Function));
+      end if;
    end Is_Expression_Function;
 
    --------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 3256e4cfacf53a1507d07023cdcebf41d2b3a7ed..6151315b0dcf571e5db862d3729346ee1a36a5b0 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -894,8 +894,9 @@ package Sem_Util is
    --  it is of protected, synchronized or task kind.
 
    function Is_Expression_Function (Subp : Entity_Id) return Boolean;
-   --  Predicate to determine whether a function entity comes from a rewritten
-   --  expression function, and should be inlined unconditionally.
+   --  Predicate to determine whether a scope entity comes from a rewritten
+   --  expression function call, and should be inlined unconditionally. Also
+   --  used to determine that such a call does not constitute a freeze point.
 
    function Is_False (U : Uint) return Boolean;
    pragma Inline (Is_False);