AI05-0071 stipulates that: In an instance, if the actual for a formal type FT
with unknown discriminants is a class-wide type CT, and the generic has a
formal subprogram with a box for a primitive operation of FT, the corresponding
actual subprogram denoted by the default is a class-wide operation whose body
is a dispatching call. This body is analyzed when the operation is frozen, and
is attached to the Freeze_Actions of the corresponding entity. Freeze actions
are not processed when expansion is disabled, so the body should not be placed
in the tree in that case, to prevent problems in the back-end when compiling
with -gnatct.

The following must compile quietly:

   gcc -c -gnat05 -gnatct pck.ads

---
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Finalization; use Ada.Finalization;

package Pck is

   type Editor_Buffer is abstract new Controlled with null record;

   overriding function "="
     (This : Editor_Buffer; Buffer : Editor_Buffer) return Boolean;

   package Buffer_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists
     (Editor_Buffer'Class);

end Pck;

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

2011-09-06  Ed Schonberg  <schonb...@adacore.com>

        * sem_ch8.adb (Check_Class_Wide_Actual): Do not generate body of
        class-wide operation if expansion is not enabled.

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 178565)
+++ sem_ch8.adb (working copy)
@@ -1859,9 +1859,12 @@
               Statements (Handled_Statement_Sequence (New_Body)));
 
             --  The generated body does not freeze. It is analyzed when the
-            --  generated operation is frozen.
+            --  generated operation is frozen. This body is only needed if
+            --  expansion is enabled.
 
-            Append_Freeze_Action (Defining_Entity (New_Decl), New_Body);
+            if Expander_Active then
+               Append_Freeze_Action (Defining_Entity (New_Decl), New_Body);
+            end if;
 
             Result := Defining_Entity (New_Decl);
          end if;

Reply via email to