This patch fixes a spurious type error in a predicate function created within
an operation in an instantiation of a container package, when the element
type is an unconstrained array with a predicate.
The following must compile quietly
gcc -c gpr2-project-registry-attribute.adb
---
with Ada.Containers.Indefinite_Ordered_Maps; use Ada;
with Ada.Strings.Less_Case_Insensitive;
package body GPR2.Project.Registry.Attribute is
function Less_Case_Insensitive
(Left, Right : Qualified_Name) return Boolean is
(Ada.Strings.Less_Case_Insensitive (String (Left), String (Right)));
package Attribute_Definitions is new Containers.Indefinite_Ordered_Maps
(Qualified_Name, Def, Less_Case_Insensitive);
end GPR2.Project.Registry.Attribute;
package GPR2.Project.Registry.Attribute is
pragma Elaborate_Body;
type Index_Kind is (No, Yes, Optional);
type Qualified_Name is new Name_Type;
type Def is record
Index : Index_Kind;
end record;
end GPR2.Project.Registry.Attribute;
package GPR2.Project.Registry is
end GPR2.Project.Registry;
package GPR2.Project is
end GPR2.Project;
package GPR2 is
type Project_Kind is
(K_Configuration, K_Abstract,
K_Standard, K_Library, K_Aggregate, K_Aggregate_Library);
--
-- Name / Value
--
subtype Name_Type is String
with Dynamic_Predicate => Name_Type'Length > 0;
subtype Value_Type is String;
end GPR2;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-07-06 Ed Schonberg <[email protected]>
* sem_ch3.adb (Analyze_Subtype_Declaration): For generated
subtypes, such as actual subtypes of unconstrained formals,
inherit predicate functions, if any, from the parent type rather
than creating redundant new ones.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 238040)
+++ sem_ch3.adb (working copy)
@@ -4802,6 +4802,24 @@
then
Set_Has_Predicates (Id);
Set_Has_Delayed_Freeze (Id);
+
+ -- Generated subtypes inherit the predicate function from the parent
+ -- (no aspects to examine on the generated declaration).
+
+ if not Comes_From_Source (N) then
+ Set_Ekind (Id, Ekind (T));
+
+ if Present (Predicate_Function (T)) then
+ Set_Predicate_Function (Id, Predicate_Function (T));
+
+ elsif Present (Ancestor_Subtype (T))
+ and then Has_Predicates (Ancestor_Subtype (T))
+ and then Present (Predicate_Function (Ancestor_Subtype (T)))
+ then
+ Set_Predicate_Function (Id,
+ Predicate_Function (Ancestor_Subtype (T)));
+ end if;
+ end if;
end if;
-- Subtype of Boolean cannot have a constraint in SPARK
