This patch fixes a compiler abort on a return statement for a function whose type is a derived type with a dynamic predicate, when the return expression has the parent type.
Compiling gpr2-attribute.adb must yield: gpr2-attribute.adb:8:14: expected type "Qualified_Name" defined at gpr2-attribute.ads:12 gpr2-attribute.adb:8:14: found type "Standard.String" --- package GPR2 is subtype Name_Type is String with Dynamic_Predicate => Name_Type'Length > 0; end GPR2; -- 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; private type Qualified_Name is new Name_Type; end GPR2.Attribute; -- package body GPR2.Attribute is function Create (Name : Name_Type) return Qualified_Name is begin -- OK: return Qualified_Name (Name); -- with below code (missing conversion) GNAT crashes return Name; end Create; end GPR2.Attribute; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-06-22 Ed Schonberg <schonb...@adacore.com> * sem_ch13.adb (Is_Predicate_Static): An inherited predicate can be static only if it applies to a scalar type.
Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 237680) +++ sem_ch13.adb (working copy) @@ -8552,8 +8552,7 @@ Expression => Expr)))); -- If declaration has not been analyzed yet, Insert declaration - -- before freeze node. - -- Insert body after freeze node. + -- before freeze node. Insert body itself after freeze node. if not Analyzed (FDecl) then Insert_Before_And_Analyze (N, FDecl); @@ -11644,9 +11643,11 @@ -- to specify a static predicate for a subtype which is inheriting a -- dynamic predicate, so the static predicate validation here ignores -- the inherited predicate even if it is dynamic. + -- In all cases, a static predicate can only apply to a scalar type. elsif Nkind (Expr) = N_Function_Call and then Is_Predicate_Function (Entity (Name (Expr))) + and then Is_Scalar_Type (Etype (First_Entity (Entity (Name (Expr))))) then return True;