* 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 <schonberg@adacore.com>
* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@244618
138bc75d-0d04-0410-961f-
82ee72b054a4
+2017-01-19 Javier Miranda <miranda@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <baird@adacore.com>
* sem_util.ads: Add new Use_Full_View Boolean parameter to
-- 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
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 --
--------------------------------------------
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 --
-----------------------
-- 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.
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.
-- 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;
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 --
-------------------------------
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 --
-----------------
-- 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
-- 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.
projects / thirdparty / gcc.git / commitdiff
