ada: More tweaks to semantic analysis of expression functions

They are exclusively about streamlining the implementation, so there should
be no functional changes.

gcc/ada/ChangeLog:

	* contracts.adb (Has_Public_Visibility_Of_Subprogram): Use Subp_Id
	throughout and Is_Expression_Function to spot expression functions.
	* ghost.adb (Is_OK_Declaration): Likewise.
	* sem_ch12.adb (Analyze_One_Association): Likewise.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Likewise.
	(Analyze_Subprogram_Specification): Fix typo.
	(Find_Corresponding_Spec): Call Is_Expression_Function.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Retrieve the expression
	by means of Expression_Of_Expression_Function.
	* sem_res.adb (Resolve_Allocator): Call Is_Expression_Function.
	(Rewrite_Renamed_Operator): Likewise.
	* sem_util.adb (Expression_Of_Expression_Function): Streamline the
	the implementation.
	(Is_Expression_Function): Likewise.

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index bde66171cbc0e40495986aadab28ce4941184e9d..86871f9dea6b42e7e31813d4a0a5e4febf8540a0 100644 (file)
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2331,7 +2331,7 @@ package body Contracts is
                --  An Initialization procedure must be considered visible even
                --  though it is internally generated.
 
-               if Is_Init_Proc (Defining_Entity (Subp_Decl)) then
+               if Is_Init_Proc (Subp_Id) then
                   return True;
 
                elsif Ekind (Scope (Typ)) /= E_Package then
@@ -2343,10 +2343,8 @@ package body Contracts is
                --  last check.
 
                elsif not Comes_From_Source (Subp_Decl)
-                 and then
-                   (Nkind (Original_Node (Subp_Decl)) /= N_Expression_Function
-                      or else not
-                        Comes_From_Source (Defining_Entity (Subp_Decl)))
+                 and then (not Is_Expression_Function (Subp_Id)
+                            or else not Comes_From_Source (Subp_Id))
                then
                   return False;
 
@@ -2358,8 +2356,7 @@ package body Contracts is
                   declare
                      Decls      : constant List_Id   :=
                                     List_Containing (Subp_Decl);
-                     Subp_Scope : constant Entity_Id :=
-                                    Scope (Defining_Entity (Subp_Decl));
+                     Subp_Scope : constant Entity_Id := Scope (Subp_Id);
                      Typ_Scope  : constant Entity_Id := Scope (Typ);
 
                   begin
@@ -2387,8 +2384,7 @@ package body Contracts is
                     (Nkind (Parent (Subp_Decl)) = N_Compilation_Unit);
 
                   declare
-                     Subp_Scope : constant Entity_Id :=
-                                    Scope (Defining_Entity (Subp_Decl));
+                     Subp_Scope : constant Entity_Id := Scope (Subp_Id);
                      Typ_Scope  : constant Entity_Id := Scope (Typ);
 
                   begin

diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 74aeae50fe5fd18ec7ce993038f033010ca9f34b..cf4774b8a27a6d769fce18b6cd21ad70cab2250f 100644 (file)
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -334,8 +334,7 @@ package body Ghost is
 
             --  Local variables
 
-            Subp_Decl : Node_Id;
-            Subp_Id   : Entity_Id;
+            Subp_Id : Entity_Id;
 
          --  Start of processing for Is_OK_Declaration
 
@@ -398,17 +397,13 @@ package body Ghost is
                   elsif Is_Predicate_Function (Subp_Id) then
                      return True;
 
-                  else
-                     Subp_Decl :=
-                       Original_Node (Unit_Declaration_Node (Subp_Id));
+                  --  The original context is an expression function that
+                  --  has been split into a spec and a body. The context is
+                  --  OK as long as the initial declaration is Ghost.
 
-                     --  The original context is an expression function that
-                     --  has been split into a spec and a body. The context is
-                     --  OK as long as the initial declaration is Ghost.
-
-                     if Nkind (Subp_Decl) = N_Expression_Function then
-                        return Is_Ghost_Declaration (Subp_Decl);
-                     end if;
+                  elsif Is_Expression_Function (Subp_Id) then
+                     return Is_Ghost_Declaration
+                             (Original_Node (Unit_Declaration_Node (Subp_Id)));
                   end if;
 
                --  Otherwise this is either an internal body or an internal

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5d8c8c3ca3468d80cd70c674c1d393fd45c8bd02..8b81a0e34eeacf43e808effe4cbad49f16530e5c 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2567,9 +2567,7 @@ package body Sem_Ch12 is
 
             if Is_Entity_Name (Match)
               and then Present (Entity (Match))
-              and then Nkind
-                (Original_Node (Unit_Declaration_Node (Entity (Match))))
-                                               = N_Expression_Function
+              and then Is_Expression_Function (Entity (Match))
             then
                Append_Elmt (Entity (Match), Actuals_To_Freeze);
             end if;

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4183da5d8360e45037b14dd8a3514b0ba80ce3e8..0886f650152cb5ff422980a5d8ec5c49dd0ca414 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -361,10 +361,7 @@ package body Sem_Ch6 is
          --  The previous entity may be an expression function as well, in
          --  which case the redeclaration is illegal.
 
-         if Present (Prev)
-           and then Nkind (Original_Node (Unit_Declaration_Node (Prev))) =
-                                                        N_Expression_Function
-         then
+         if Present (Prev) and then Is_Expression_Function (Prev) then
             Error_Msg_Sloc := Sloc (Prev);
             Error_Msg_N ("& conflicts with declaration#", Def_Id);
             return;
@@ -4001,12 +3998,8 @@ package body Sem_Ch6 is
 
             --  Finally, a body generated for an expression function copies
             --  the profile of the function and no check is needed either.
-            --  If the body is the completion of a previous function
-            --  declared elsewhere, the conformance check is required.
 
-            elsif From_Expression_Function
-              and then Sloc (Spec_Id) = Sloc (Body_Id)
-            then
+            elsif Is_Expression_Function (Spec_Id) then
                Conformant := True;
 
             else
@@ -4814,9 +4807,7 @@ package body Sem_Ch6 is
          --  been preanalyzed already, if 'access was applied to it.
 
          else
-            if Nkind (Original_Node (Unit_Declaration_Node (Spec_Id))) /=
-                                                       N_Expression_Function
-            then
+            if not Is_Expression_Function (Spec_Id) then
                pragma Assert (No (Last_Entity (Body_Id)));
                null;
             end if;
@@ -5497,7 +5488,7 @@ package body Sem_Ch6 is
          --  derived from a synchronized interface.
 
          --  This modification is not done for invariant procedures because
-         --  the corresponding record may not necessarely be visible when the
+         --  the corresponding record may not necessarily be visible when the
          --  concurrent type acts as the full view of a private type.
 
          --    package Pack is
@@ -10117,11 +10108,10 @@ package body Sem_Ch6 is
                --  Expression functions can be completions, but cannot be
                --  completed by an explicit body.
 
-               elsif Comes_From_Source (E)
-                 and then Comes_From_Source (N)
+               elsif Comes_From_Source (N)
                  and then Nkind (N) = N_Subprogram_Body
-                 and then Nkind (Original_Node (Unit_Declaration_Node (E))) =
-                            N_Expression_Function
+                 and then Comes_From_Source (E)
+                 and then Is_Expression_Function (E)
                then
                   Error_Msg_Sloc := Sloc (E);
                   Error_Msg_N ("body conflicts with expression function#", N);

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 2aa3021cfa628913a654743a896fe751425d165a..ff6dcd5eff6a87f6450fe310086018a0844300b1 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -3555,9 +3555,7 @@ package body Sem_Ch8 is
             Freeze_Expr_Types
               (Def_Id => Entity (Nam),
                Typ    => Etype (Entity (Nam)),
-               Expr   =>
-                 Expression
-                   (Original_Node (Unit_Declaration_Node (Entity (Nam)))),
+               Expr   => Expression_Of_Expression_Function (Entity (Nam)),
                N      => N);
          end if;
 

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 270affe5ccb002851ae1f81755e4386e289b7f3e..5b90d4ee7a145e4a061694aa5045e70dc73df87b 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5512,12 +5512,8 @@ package body Sem_Res is
 
          if Is_Limited_Type (Etype (E))
            and then Comes_From_Source (N)
-           and then
-             (Comes_From_Source (Parent (N))
-               or else
-                 (Ekind (Current_Scope) = E_Function
-                   and then Nkind (Original_Node (Unit_Declaration_Node
-                              (Current_Scope))) = N_Expression_Function))
+           and then (Comes_From_Source (Parent (N))
+                      or else Is_Expression_Function (Current_Scope))
            and then not In_Instance_Body
          then
             if not OK_For_Limited_Init (Etype (E), Expression (E)) then
@@ -13033,17 +13029,10 @@ package body Sem_Res is
       --  Likewise when an expression function is being preanalyzed, since the
       --  expression will be reanalyzed as part of the generated body.
 
-      if In_Spec_Expression then
-         declare
-            S : constant Entity_Id := Current_Scope_No_Loops;
-         begin
-            if Ekind (S) = E_Function
-              and then Nkind (Original_Node (Unit_Declaration_Node (S))) =
-                         N_Expression_Function
-            then
-               return;
-            end if;
-         end;
+      if In_Spec_Expression
+        and then Is_Expression_Function (Current_Scope_No_Loops)
+      then
+         return;
       end if;
 
       Op_Node := New_Node (Operator_Kind (Nam, Is_Binary), Sloc (N));

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index aae54bca093b00b0a2b28d7ac582833cdc1e12d1..223dad32d0cba374bca123e4352eece149ee53b3 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8575,27 +8575,21 @@ package body Sem_Util is
    function Expression_Of_Expression_Function
      (Subp : Entity_Id) return Node_Id
    is
-      Expr_Func : Node_Id := Empty;
+      Subp_Decl : Node_Id;
 
    begin
       pragma Assert (Is_Expression_Function_Or_Completion (Subp));
 
-      if Nkind (Original_Node (Subprogram_Spec (Subp))) =
-           N_Expression_Function
-      then
-         Expr_Func := Original_Node (Subprogram_Spec (Subp));
+      --  The function declaration is either an expression function or is
+      --  completed by an expression function.
 
-      elsif Nkind (Original_Node (Subprogram_Body (Subp))) =
-              N_Expression_Function
-      then
-         Expr_Func := Original_Node (Subprogram_Body (Subp));
+      Subp_Decl := Unit_Declaration_Node (Subp);
 
-      else
-         pragma Assert (False);
-         null;
+      if Nkind (Original_Node (Subp_Decl)) /= N_Expression_Function then
+         Subp_Decl := Unit_Declaration_Node (Corresponding_Body (Subp_Decl));
       end if;
 
-      return Original_Node (Expression (Expr_Func));
+      return Original_Node (Expression (Original_Node (Subp_Decl)));
    end Expression_Of_Expression_Function;
 
    -------------------------------
@@ -18131,13 +18125,9 @@ package body Sem_Util is
 
    function Is_Expression_Function (Subp : Entity_Id) return Boolean is
    begin
-      if Ekind (Subp) in E_Function | E_Subprogram_Body then
-         return
-           Nkind (Original_Node (Unit_Declaration_Node (Subp))) =
-             N_Expression_Function;
-      else
-         return False;
-      end if;
+      return Ekind (Subp) in E_Function | E_Subprogram_Body
+        and then Nkind (Original_Node (Unit_Declaration_Node (Subp))) =
+                                                         N_Expression_Function;
    end Is_Expression_Function;
 
    ------------------------------------------