In the context of a predicate function the formal and the actual in a call may
have different views of the same type, because of the delayed analysis of
predicates aspects. This patch extends existing code that handles this
discrepancy, to cover private and full views as well.
Executing the following:
gnatmake -q main
main
must yield:
toto
---
with GPR2.Attribute; use GPR2.Attribute;
procedure Main is
Q_Name : constant GPR2.Attribute.Qualified_Name :=
GPR2.Attribute.Create ("toto");
begin
Dump (Q_Name);
end Main;
---
package GPR2 is
subtype Name_Type is String
with Dynamic_Predicate => Name_Type'Length > 0;
end GPR2;
---
with Text_IO; use Text_IO;
package body GPR2.Attribute is
function Create (Name : Name_Type) return Qualified_Name is
begin
return Qualified_Name (Name);
end;
procedure Dump (Obj : Qualified_Name) is
begin
Put_Line (String (Obj));
end;
end GPR2.Attribute;
---
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package GPR2.Attribute is
type Qualified_Name (<>) is private;
function Create (Name : Name_Type) return Qualified_Name;
procedure Dump (Obj : Qualified_Name);
private
type Qualified_Name is new Name_Type;
end GPR2.Attribute;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-07-04 Ed Schonberg <[email protected]>
* sem_ch4.adb (Resolve_One_Call): In the context of a predicate
function the formal and the actual in a call may have different
views of the same type, because of the delayed analysis of
predicates aspects. Extend the patch that handles this potential
discrepancy to handle private and full views as well.
* sem_ch8.adb (Find_Selected_Component): Refine predicate that
produces additional error when an illegal selected component
looks like a prefixed call whose first formal is untagged.
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 237957)
+++ sem_ch4.adb (working copy)
@@ -3413,9 +3413,17 @@
-- an incomplete type, while resolution of the corresponding
-- predicate function may see the full view, as a consequence
-- of the delayed resolution of the corresponding expressions.
+ -- This can occur in the body of a predicate function, or in
+ -- a call to such.
- elsif Ekind (Etype (Formal)) = E_Incomplete_Type
- and then Full_View (Etype (Formal)) = Etype (Actual)
+ elsif ((Ekind (Current_Scope) = E_Function
+ and then Is_Predicate_Function (Current_Scope))
+ or else (Ekind (Nam) = E_Function
+ and then Is_Predicate_Function (Nam)))
+ and then
+ (Base_Type (Underlying_Type (Etype (Formal))) =
+ Base_Type (Underlying_Type (Etype (Actual))))
+ and then Serious_Errors_Detected = 0
then
Set_Etype (Formal, Etype (Actual));
Next_Actual (Actual);
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 237957)
+++ sem_ch8.adb (working copy)
@@ -6983,7 +6983,8 @@
elsif Nkind (P) /= N_Attribute_Reference then
-- This may have been meant as a prefixed call to a primitive
- -- of an untagged type.
+ -- of an untagged type. If it is a function call check type of
+ -- its first formal and add explanation.
declare
F : constant Entity_Id :=
@@ -6992,8 +6993,7 @@
if Present (F)
and then Is_Overloadable (F)
and then Present (First_Entity (F))
- and then Etype (First_Entity (F)) = Etype (P)
- and then not Is_Tagged_Type (Etype (P))
+ and then not Is_Tagged_Type (Etype (First_Entity (F)))
then
Error_Msg_N
("prefixed call is only allowed for objects "
