https://gcc.gnu.org/g:5745b0e3c4d1470b16b8dfcb956b9320eed886ff
commit r17-736-g5745b0e3c4d1470b16b8dfcb956b9320eed886ff Author: Eric Botcazou <[email protected]> Date: Wed Jan 14 18:01:54 2026 +0100 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: --- 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 bde66171cbc0..86871f9dea6b 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 74aeae50fe5f..cf4774b8a27a 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 5d8c8c3ca346..8b81a0e34eea 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 4183da5d8360..0886f650152c 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 2aa3021cfa62..ff6dcd5eff6a 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 270affe5ccb0..5b90d4ee7a14 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 aae54bca093b..223dad32d0cb 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; ------------------------------------------
