+2017-01-19 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <duff@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
* lib-xref-spark_specific.adb, sem_util.adb, sem_util.ads,
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
-- 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
-- --
-- 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- --
-- 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;
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