Patchwork [Ada] Equality on classwide arguments of constrained private extensions

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 5, 2010, 9:57 a.m.
Message ID <20101005095750.GA8044@adacore.com>
Download mbox | patch
Permalink /patch/66784/
State New
Headers show

Comments

Arnaud Charlet - Oct. 5, 2010, 9:57 a.m.
This patch simplifies type compatibility checks when one of the types is class-
wide, and the other is the specific type, which is a private extension that
constrains the discriminant of its parent.

The following must compile quietly:
   gcc -c main.adb

with P;
procedure Main is
   procedure Test
     (Left : access P.Child_1_3'Class;
      Right : access P.Child_1_3'Class) is
   begin
      if P."=" (Left.all, Right.all) then
         null;
      end if;
   end Test;
   null;
end Main;

package P is
   type Root_1 (V : Integer) is tagged record
      F : Integer := 15;
   end record;

   type Child_1_3 is new Root_1 (1) with private;

private
   type Child_1_3 is new Root_1 (1) with null record;
end P;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Covers): In a dispatching context, T1 covers T2 if T2
	is class-wide and T1 is its specific type.

Patch

Index: sem_type.adb
===================================================================
--- sem_type.adb	(revision 164940)
+++ sem_type.adb	(working copy)
@@ -876,10 +876,13 @@  package body Sem_Type is
             return False;
          end;
 
-      --  In a dispatching call the actual may be class-wide
+         --  In a dispatching call the actual may be class-wide, the formal
+         --  may be its specific type, or that of a descendent of it.
 
       elsif Is_Class_Wide_Type (T2)
-        and then Base_Type (Root_Type (T2)) = Base_Type (T1)
+        and then
+          (Class_Wide_Type (T1) = T2
+             or else Base_Type (Root_Type (T2)) = Base_Type (T1))
       then
          return True;