From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/contracts.adb | 14 +++++---------
gcc/ada/ghost.adb | 19 +++++++------------
gcc/ada/sem_ch12.adb | 4 +---
gcc/ada/sem_ch6.adb | 24 +++++++-----------------
gcc/ada/sem_ch8.adb | 4 +---
gcc/ada/sem_res.adb | 23 ++++++-----------------
gcc/ada/sem_util.adb | 30 ++++++++++--------------------
7 files changed, 37 insertions(+), 81 deletions(-)
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index bde66171cbc..86871f9dea6 100644
--- 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 74aeae50fe5..cf4774b8a27 100644
--- 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 5d8c8c3ca34..8b81a0e34ee 100644
--- 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 4183da5d836..0886f650152 100644
--- 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 2aa3021cfa6..ff6dcd5eff6 100644
--- 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 270affe5ccb..5b90d4ee7a1 100644
--- 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 aae54bca093..223dad32d0c 100644
--- 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;
------------------------------------------
--
2.53.0
