2005-12-05 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 9 Dec 2005 17:21:06 +0000 (17:21 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 9 Dec 2005 17:21:06 +0000 (17:21 +0000)
* sem_ch12.adb (Subtypes_Match): Handle properly Ada05 arrays of
anonymous access types.

* sem_eval.adb (Subtypes_Statically_Match): Implement new rules for
matching of anonymous access types and anonymous access to subprogram
types. 'R'M 4.9.1 (2/2).

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108301 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/sem_ch12.adb
gcc/ada/sem_eval.adb

index 470f5ed..5e8e6dc 100644 (file)
@@ -8090,16 +8090,22 @@ package body Sem_Ch12 is
 
       begin
          return (Base_Type (T) = Base_Type (Act_T)
---  why is the and then commented out here???
---                  and then Is_Constrained (T) = Is_Constrained (Act_T)
                   and then Subtypes_Statically_Match (T, Act_T))
 
            or else (Is_Class_Wide_Type (Gen_T)
                      and then Is_Class_Wide_Type (Act_T)
                      and then
-                       Subtypes_Match (
-                         Get_Instance_Of (Root_Type (Gen_T)),
-                         Root_Type (Act_T)));
+                       Subtypes_Match
+                        (Get_Instance_Of (Root_Type (Gen_T)),
+                         Root_Type (Act_T)))
+
+           or else
+             ((Ekind (Gen_T) = E_Anonymous_Access_Subprogram_Type
+                 or else Ekind (Gen_T) = E_Anonymous_Access_Type)
+               and then Ekind (Act_T) = Ekind (Gen_T)
+               and then
+                 Subtypes_Statically_Match
+                   (Designated_Type (Gen_T), Designated_Type (Act_T)));
       end Subtypes_Match;
 
       -----------------------------------------
index d99e042..3e354ec 100644 (file)
@@ -38,6 +38,7 @@ with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Sem;      use Sem;
 with Sem_Cat;  use Sem_Cat;
+with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
@@ -4056,9 +4057,21 @@ package body Sem_Eval is
          end;
 
       elsif Is_Access_Type (T1) then
-         return Subtypes_Statically_Match
-                  (Designated_Type (T1),
-                   Designated_Type (T2));
+         if Can_Never_Be_Null (T1) /= Can_Never_Be_Null (T2) then
+            return False;
+
+         elsif Ekind (T1) = E_Access_Subprogram_Type then
+            return
+              Subtype_Conformant
+                (Designated_Type (T1),
+                 Designated_Type (T1));
+         else
+            return
+              Subtypes_Statically_Match
+                (Designated_Type (T1),
+                 Designated_Type (T2))
+              and then Is_Access_Constant (T1) = Is_Access_Constant (T2);
+         end if;
 
       --  All other types definitely match