Checks that would read the value of a discriminant are suppressed on types
that are unchecked unions. If such a record has components whose types have
invariants, applying those checks would require determining the variant in
which they reside, and this cannot be done on an unchecked union. THis patch
recognizes such cases and warns that there are no invariant checks on the
components of the record.

Compiling unc_rec.ads must yield:

   cannot generate code for file unc_rec.ads (package spec)
   unc_rec.ads:12:24: warning:
     invariants cannot be checked on components of unchecked_union type "Rec"

---
package Unc_Rec is
   type Comp is private
     with Invariant => Comp_OK (Comp);
   type Rec (<>) is private;
   function Comp_OK (It : Comp) return Boolean;
private
   type Comp is new Float;

   type Rec (Flag : Boolean) is record
      case Flag is
         when True => Val : Integer;
         when False => Weight : Comp;
      end case;
   end record;

   pragma Unchecked_Union (Rec);
end;
     
Tested on x86_64-pc-linux-gnu, committed on trunk

2014-07-31  Ed Schonberg  <schonb...@adacore.com>

        * exp_ch3.adb (Build_Invariant_Checks): If the enclosing record
        is an unchecked_union, warn that invariants will not be checked
        on components that have them.

Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 213322)
+++ exp_ch3.adb (working copy)
@@ -3763,8 +3763,16 @@
                if Has_Invariants (Etype (Id))
                  and then In_Open_Scopes (Scope (R_Type))
                then
-                  Append_To (Stmts, Build_Component_Invariant_Call (Id));
+                  if Has_Unchecked_Union (R_Type) then
+                     Error_Msg_NE
+                       ("invariants cannot be checked on components of "
+                         & "unchecked_union type&?", Decl, R_Type);
+                     return Empty_List;
 
+                  else
+                     Append_To (Stmts, Build_Component_Invariant_Call (Id));
+                  end if;
+
                elsif Is_Access_Type (Etype (Id))
                  and then not Is_Access_Constant (Etype (Id))
                  and then Has_Invariants (Designated_Type (Etype (Id)))

Reply via email to