[gcc r11-5361] [Ada] Spurious error on instance with predicated actual

[gcc r11-5361] [Ada] Spurious error on instance with predicated actual

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:55fae09dcb8257c8f4be90198f675aafe4ed8f9c

commit r11-5361-g55fae09dcb8257c8f4be90198f675aafe4ed8f9c
Author: Ed Schonberg <schonberg@adacore.com>
Date:   Fri Oct 16 14:25:03 2020 -0400

    [Ada] Spurious error on instance with predicated actual
    
    gcc/ada/
    
            * sem_eval.adb (Subtypes_Statically_Compatible): Scalar types
            with compatible static bounds are statically compatible if
            predicates are compatible, even if they are not static subtypes.
            Same for private types without discriminants.

Diff:
---
 gcc/ada/sem_eval.adb | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 52aa8c111da..443926f1e7e 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -6311,11 +6311,13 @@ package body Sem_Eval is
          if Subtypes_Statically_Match (T1, T2) then
             return True;
 
-         --  If either subtype is nonstatic then they're not compatible
+         --  A scalar subtype S1 is compatible with S2 if their bounds
+         --  are static and compatible, even if S1 has dynamic predicates
+         --  and is thus non-static. Predicate compatibility has been
+         --  checked above.
 
-         elsif not Is_OK_Static_Subtype (T1)
-                 or else
-               not Is_OK_Static_Subtype (T2)
+         elsif not Is_Static_Range (Scalar_Range (T1))
+                 or else not Is_Static_Range (Scalar_Range (T2))
          then
             return False;
 
@@ -6363,6 +6365,14 @@ package body Sem_Eval is
            and then not (Can_Never_Be_Null (T2)
                           and then not Can_Never_Be_Null (T1));
 
+      --  Private types without discriminants can be handled specially.
+      --  Predicate matching has been checked above.
+
+      elsif Is_Private_Type (T1)
+        and then not Has_Discriminants (T1)
+      then
+         return not Has_Discriminants (T2);
+
       --  All other cases
 
       else