This patch fixes a spurious subtype conformance error in a child unit when
the actual is a private type declared in a package instantiation, whose full
view is a constrained discriminated type.
The following must compile quietly:
gcc -c new_bounded_strings-child.adb
---
with G_Instance;
package body New_Bounded_Strings.Child is
procedure P (S : New_Bounded_Strings.NBString) is null;
begin
G_Instance.R (P'Access);
end;
---
package New_Bounded_Strings.Child is -- Needs to be a child package
procedure P (S : New_Bounded_Strings.NBString);
end;
--
with Ada.Strings.Bounded;
package Bounded_Strings_Instance is
package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (10);
type BString is new BS.Bounded_String;
end;
--
generic
type T is private;
package G is
type Proc is access procedure (X : T);
procedure R (P : Proc);
end;
--
with G;
with New_Bounded_Strings;
package G_Instance is new G (New_Bounded_Strings.NBString);
--
with Bounded_Strings_Instance;
package New_Bounded_Strings is
type NBString is private; -- compiles if not private
private
type NBString is new Bounded_Strings_Instance.BString;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-23 Ed Schonberg <schonb...@adacore.com>
* sem_eval.adb (Subtypes_Statically_Match): For a generic actual
type, check for the presence of discriminants in its parent type,
against the presence of discriminants in the context type.
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 216582)
+++ sem_eval.adb (working copy)
@@ -5737,7 +5737,17 @@
-- same base type.
if Has_Discriminants (T1) /= Has_Discriminants (T2) then
- if In_Instance then
+ -- A generic actual type is declared through a subtype declaration
+ -- and may have an inconsistent indication of the presence of
+ -- discriminants, so check the type it renames.
+
+ if Is_Generic_Actual_Type (T1)
+ and then not Has_Discriminants (Etype (T1))
+ and then not Has_Discriminants (T2)
+ then
+ return True;
+
+ elsif In_Instance then
if Is_Private_Type (T2)
and then Present (Full_View (T2))
and then Has_Discriminants (Full_View (T2))
