From 0929d66bf81be1b0fca5537d946cd068dd731f99 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 19 Jan 2017 12:51:22 +0100 Subject: [PATCH] [multiple changes] 2017-01-19 Ed Schonberg * sem_ch4.ads, sem_ch4.adb (Try_Object_Operation): Make subprogram public, for use elsewhere. * sem_ch6.adb (Analyze_Procedure_Call): In SPARK_Mode and within an Inlined_body, recognize a call that uses object notation and has not been rewritten as a regular call because regular expansion has not taken place. 2017-01-19 Bob Duff * checks.adb (Apply_Type_Conversion_Checks): Disable small optimization in case of generic formal discrete types, because it causes crashes in the compiler when built with assertions on. From-SVN: r244620 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/checks.adb | 11 +++++++---- gcc/ada/sem_ch4.adb | 12 ------------ gcc/ada/sem_ch4.ads | 14 +++++++++++++- gcc/ada/sem_ch6.adb | 26 +++++++++++++++++++++++++- 5 files changed, 60 insertions(+), 18 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7f7fcd8b3e4..5eda55755df 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2017-01-19 Ed Schonberg + + * sem_ch4.ads, sem_ch4.adb (Try_Object_Operation): Make subprogram + public, for use elsewhere. + * sem_ch6.adb (Analyze_Procedure_Call): In SPARK_Mode and within + an Inlined_body, recognize a call that uses object notation + and has not been rewritten as a regular call because regular + expansion has not taken place. + +2017-01-19 Bob Duff + + * checks.adb (Apply_Type_Conversion_Checks): Disable small optimization + in case of generic formal discrete types, because it causes crashes in + the compiler when built with assertions on. + 2017-01-19 Hristian Kirtchev * lib-xref-spark_specific.adb, sem_util.adb, sem_util.ads, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 80b4b4b782f..1e2231b3615 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -3391,14 +3391,17 @@ package body Checks is and then not Float_To_Int then -- A small optimization: the attribute 'Pos applied to an - -- enumeration type has a known range, even though its type - -- is Universal_Integer. So in numeric conversions it is - -- usually within range of the target integer type. Use the - -- static bounds of the base types to check. + -- enumeration type has a known range, even though its type is + -- Universal_Integer. So in numeric conversions it is usually + -- within range of the target integer type. Use the static + -- bounds of the base types to check. Disable this optimization + -- in case of a generic formal discrete type, because we don't + -- necessarily know the upper bound yet. if Nkind (Expr) = N_Attribute_Reference and then Attribute_Name (Expr) = Name_Pos and then Is_Enumeration_Type (Etype (Prefix (Expr))) + and then not Is_Generic_Type (Etype (Prefix (Expr))) and then Is_Integer_Type (Target_Type) then declare diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index db41afb4797..56da4061867 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -323,18 +323,6 @@ package body Sem_Ch4 is -- subprogram, and the call F (X) interpreted as F.all (X). In this case -- the call may be overloaded with both interpretations. - function Try_Object_Operation - (N : Node_Id; - CW_Test_Only : Boolean := False) return Boolean; - -- Ada 2005 (AI-252): Support the object.operation notation. If node N - -- is a call in this notation, it is transformed into a normal subprogram - -- call where the prefix is a parameter, and True is returned. If node - -- N is not of this form, it is unchanged, and False is returned. If - -- CW_Test_Only is true then N is an N_Selected_Component node which - -- is part of a call to an entry or procedure of a tagged concurrent - -- type and this routine is invoked to search for class-wide subprograms - -- conflicting with the target entity. - procedure wpo (T : Entity_Id); pragma Warnings (Off, wpo); -- Used for debugging: obtain list of primitive operations even if diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads index 0a196439fb1..a6105c1d5f1 100644 --- a/gcc/ada/sem_ch4.ads +++ b/gcc/ada/sem_ch4.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -64,4 +64,16 @@ package Sem_Ch4 is -- The resolution of the construct requires some semantic information -- on the prefix and the indexes. + function Try_Object_Operation + (N : Node_Id; + CW_Test_Only : Boolean := False) return Boolean; + -- Ada 2005 (AI-252): Support the object.operation notation. If node N + -- is a call in this notation, it is transformed into a normal subprogram + -- call where the prefix is a parameter, and True is returned. If node + -- N is not of this form, it is unchanged, and False is returned. If + -- CW_Test_Only is true then N is an N_Selected_Component node which + -- is part of a call to an entry or procedure of a tagged concurrent + -- type and this routine is invoked to search for class-wide subprograms + -- conflicting with the target entity. + end Sem_Ch4; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 21f076932dc..6e4818d6e3e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1711,7 +1711,31 @@ package body Sem_Ch6 is E_Function, E_Procedure) then - Analyze_Call_And_Resolve; + -- When front-end inlining is enabled, as with SPARK_Mode, a call + -- in prefix notation may still be missing its controlling argument, + -- so perform the transformation now. + + if SPARK_Mode = On and then In_Inlined_Body then + declare + Subp : constant Entity_Id := Entity (Selector_Name (P)); + Typ : constant Entity_Id := Etype (Prefix (P)); + + begin + if Is_Tagged_Type (Typ) + and then Present (First_Formal (Subp)) + and then Etype (First_Formal (Subp)) = Typ + and then Try_Object_Operation (P) + then + return; + + else + Analyze_Call_And_Resolve; + end if; + end; + + else + Analyze_Call_And_Resolve; + end if; elsif Nkind (P) = N_Selected_Component and then Ekind (Entity (Selector_Name (P))) = E_Entry_Family -- 2.30.2