From 40bf00b1f85afad60951ed3c07b5ffd6414241cf Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 19 Jan 2017 12:42:31 +0100 Subject: [PATCH] [multiple changes] 2017-01-19 Javier Miranda * sem_util.ads, sem_util.adb (Expression_Of_Expression_Function): New subprogram. (Is_Inlinable_Expression_Function): New subprogram. * exp_ch6.ads, exp_ch6.adb (Expression_Of_Expression_Function): Moved to Sem_Util. (Is_Inlinable_Expression_Function): Moved to Sem_Util. 2017-01-19 Ed Schonberg * sem_ch4.adb (Diagnose_Call): Improve error message when a selected component has a prefix that might be interpreted as a parameterless function call, but none of the candidate interpretations is parameterless, and there is a hidden homonym of the prefix that is a package. * sem_ch8.adb (Find_Selected_Component): If the prefix might be interpreted as a parameterless function call and its analysis fails, do not call Analyze_Selected_Component. From-SVN: r244618 --- gcc/ada/ChangeLog | 20 +++++++++++++ gcc/ada/exp_ch6.adb | 69 -------------------------------------------- gcc/ada/exp_ch6.ads | 14 --------- gcc/ada/sem_ch4.adb | 32 ++++++++++++++++++++ gcc/ada/sem_ch8.adb | 13 ++++++++- gcc/ada/sem_util.adb | 65 +++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 18 ++++++++++++ 7 files changed, 147 insertions(+), 84 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 55f5b1f2d1d..64d929b09d0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-01-19 Javier Miranda + + * sem_util.ads, sem_util.adb (Expression_Of_Expression_Function): New + subprogram. + (Is_Inlinable_Expression_Function): New subprogram. + * exp_ch6.ads, exp_ch6.adb (Expression_Of_Expression_Function): Moved + to Sem_Util. + (Is_Inlinable_Expression_Function): Moved to Sem_Util. + +2017-01-19 Ed Schonberg + + * sem_ch4.adb (Diagnose_Call): Improve error message when a + selected component has a prefix that might be interpreted + as a parameterless function call, but none of the candidate + interpretations is parameterless, and there is a hidden homonym + of the prefix that is a package. + * sem_ch8.adb (Find_Selected_Component): If the prefix might be + interpreted as a parameterless function call and its analysis + fails, do not call Analyze_Selected_Component. + 2017-01-19 Steve Baird * sem_util.ads: Add new Use_Full_View Boolean parameter to diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4e03bd10df5..22caddd6590 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -223,10 +223,6 @@ package body Exp_Ch6 is -- Expand simple return from function. In the case where we are returning -- from a function body this is called by Expand_N_Simple_Return_Statement. - function Expression_Of_Expression_Function - (Subp : Entity_Id) return Node_Id; - -- Return the expression of expression function Subp - function Has_Unconstrained_Access_Discriminants (Subtyp : Entity_Id) return Boolean; -- Returns True if the given subtype is unconstrained and has one or more @@ -6964,36 +6960,6 @@ package body Exp_Ch6 is end if; end Expand_Simple_Function_Return; - --------------------------------------- - -- Expression_Of_Expression_Function -- - --------------------------------------- - - function Expression_Of_Expression_Function - (Subp : Entity_Id) return Node_Id - is - Expr_Func : 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)); - - elsif Nkind (Original_Node (Subprogram_Body (Subp))) = - N_Expression_Function - then - Expr_Func := Original_Node (Subprogram_Body (Subp)); - - else - pragma Assert (False); - null; - end if; - - return Original_Node (Expression (Expr_Func)); - end Expression_Of_Expression_Function; - -------------------------------------------- -- Has_Unconstrained_Access_Discriminants -- -------------------------------------------- @@ -7323,41 +7289,6 @@ package body Exp_Ch6 is end if; end Freeze_Subprogram; - -------------------------------------- - -- Is_Inlinable_Expression_Function -- - -------------------------------------- - - function Is_Inlinable_Expression_Function - (Subp : Entity_Id) return Boolean - is - Return_Expr : Node_Id; - - begin - if Is_Expression_Function_Or_Completion (Subp) - and then Has_Pragma_Inline_Always (Subp) - and then Needs_No_Actuals (Subp) - and then No (Contract (Subp)) - and then not Is_Dispatching_Operation (Subp) - and then Needs_Finalization (Etype (Subp)) - and then not Is_Class_Wide_Type (Etype (Subp)) - and then not (Has_Invariants (Etype (Subp))) - and then Present (Subprogram_Body (Subp)) - and then Was_Expression_Function (Subprogram_Body (Subp)) - then - Return_Expr := Expression_Of_Expression_Function (Subp); - - -- The returned object must not have a qualified expression and its - -- nominal subtype must be statically compatible with the result - -- subtype of the expression function. - - return - Nkind (Return_Expr) = N_Identifier - and then Etype (Return_Expr) = Etype (Subp); - end if; - - return False; - end Is_Inlinable_Expression_Function; - ----------------------- -- Is_Null_Procedure -- ----------------------- diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 1facf76ed6a..249bf14a10b 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -137,20 +137,6 @@ package Exp_Ch6 is -- that requires handling as a build-in-place call or is a qualified -- expression applied to such a call; otherwise returns False. - function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean; - -- Return True if Subp is an expression function that fulfills all the - -- following requirements for inlining: - -- 1. pragma/aspect Inline_Always - -- 2. No formals - -- 3. No contracts - -- 4. No dispatching primitive - -- 5. Result subtype controlled (or with controlled components) - -- 6. Result subtype not subject to type-invariant checks - -- 7. Result subtype not a class-wide type - -- 8. Return expression naming an object global to the function - -- 9. Nominal subtype of the returned object statically compatible - -- with the result subtype of the expression function. - function Is_Null_Procedure (Subp : Entity_Id) return Boolean; -- Predicate to recognize stubbed procedures and null procedures, which -- can be inlined unconditionally in all cases. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index d2fa0a4d899..8fd886fdb7e 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -5881,6 +5881,38 @@ package body Sem_Ch4 is end loop; end if; + -- Before listing the possible candidates, check whether this + -- a prefix of a selected component that has been rewritten as + -- a parameterless function call because there is a callable + -- candidate interpretation. If there is a hidden package in + -- the list of homonyms of the function name (bad programming + -- style in any case) suggest that this is the intended entity. + + if No (Parameter_Associations (N)) + and then Nkind (Parent (N)) = N_Selected_Component + and then Nkind (Parent (Parent (N))) in N_Declaration + and then Is_Overloaded (Nam) + then + declare + Ent : Entity_Id; + + begin + Ent := Current_Entity (Nam); + while Present (Ent) loop + if Ekind (Ent) = E_Package then + Error_Msg_N + ("no legal interpretations as function call,!", Nam); + Error_Msg_NE ("\package& is not visible", N, Ent); + Rewrite (Parent (N), + New_Occurrence_Of (Any_Type, Sloc (N))); + return; + end if; + + Ent := Homonym (Ent); + end loop; + end; + end if; + -- Analyze each candidate call again, with full error reporting -- for each. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 10233500398..abe5bea3709 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -7048,7 +7048,18 @@ package body Sem_Ch8 is -- Now analyze the reformatted node Analyze_Call (P); - Analyze_Selected_Component (N); + + -- If the prefix is illegal after this transformation, + -- there may be visibility errors on the prefix. The + -- safest is to treat the selected component as an error. + + if Error_Posted (P) then + Set_Etype (N, Any_Type); + return; + + else + Analyze_Selected_Component (N); + end if; end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 56171e27e3a..f83d9ee3fea 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6691,6 +6691,36 @@ package body Sem_Util is end if; end Explain_Limited_Type; + --------------------------------------- + -- Expression_Of_Expression_Function -- + --------------------------------------- + + function Expression_Of_Expression_Function + (Subp : Entity_Id) return Node_Id + is + Expr_Func : 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)); + + elsif Nkind (Original_Node (Subprogram_Body (Subp))) = + N_Expression_Function + then + Expr_Func := Original_Node (Subprogram_Body (Subp)); + + else + pragma Assert (False); + null; + end if; + + return Original_Node (Expression (Expr_Func)); + end Expression_Of_Expression_Function; + ------------------------------- -- Extensions_Visible_Status -- ------------------------------- @@ -13073,6 +13103,41 @@ package body Sem_Util is and then Defining_Identifier (Parent (E)) = Typ; end Is_Inherited_Operation_For_Type; + -------------------------------------- + -- Is_Inlinable_Expression_Function -- + -------------------------------------- + + function Is_Inlinable_Expression_Function + (Subp : Entity_Id) return Boolean + is + Return_Expr : Node_Id; + + begin + if Is_Expression_Function_Or_Completion (Subp) + and then Has_Pragma_Inline_Always (Subp) + and then Needs_No_Actuals (Subp) + and then No (Contract (Subp)) + and then not Is_Dispatching_Operation (Subp) + and then Needs_Finalization (Etype (Subp)) + and then not Is_Class_Wide_Type (Etype (Subp)) + and then not (Has_Invariants (Etype (Subp))) + and then Present (Subprogram_Body (Subp)) + and then Was_Expression_Function (Subprogram_Body (Subp)) + then + Return_Expr := Expression_Of_Expression_Function (Subp); + + -- The returned object must not have a qualified expression and its + -- nominal subtype must be statically compatible with the result + -- subtype of the expression function. + + return + Nkind (Return_Expr) = N_Identifier + and then Etype (Return_Expr) = Etype (Subp); + end if; + + return False; + end Is_Inlinable_Expression_Function; + ----------------- -- Is_Iterator -- ----------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 5b661c97e8b..826334042a4 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -615,6 +615,10 @@ package Sem_Util is -- continuation lines to the message explaining why type T is limited. -- Messages are placed at node N. + function Expression_Of_Expression_Function + (Subp : Entity_Id) return Node_Id; + -- Return the expression of expression function Subp + type Extensions_Visible_Mode is (Extensions_Visible_None, -- Extensions_Visible does not yield a mode when SPARK_Mode is off. This @@ -1489,6 +1493,20 @@ package Sem_Util is -- E is a subprogram. Return True is E is an implicit operation inherited -- by the derived type declaration for type Typ. + function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean; + -- Return True if Subp is an expression function that fulfills all the + -- following requirements for inlining: + -- 1. pragma/aspect Inline_Always + -- 2. No formals + -- 3. No contracts + -- 4. No dispatching primitive + -- 5. Result subtype controlled (or with controlled components) + -- 6. Result subtype not subject to type-invariant checks + -- 7. Result subtype not a class-wide type + -- 8. Return expression naming an object global to the function + -- 9. Nominal subtype of the returned object statically compatible + -- with the result subtype of the expression function. + function Is_Iterator (Typ : Entity_Id) return Boolean; -- AI05-0139-2: Check whether Typ is one of the predefined interfaces in -- Ada.Iterator_Interfaces, or it is derived from one. -- 2.30.2