Patchwork [Ada] Illegal component clause for inherited component in extension

login
register
mail settings
Submitter Arnaud Charlet
Date Jan. 3, 2013, 11:13 a.m.
Message ID <20130103111313.GA27653@adacore.com>
Download mbox | patch
Permalink /patch/209222/
State New
Headers show

Comments

Arnaud Charlet - Jan. 3, 2013, 11:13 a.m.
This change fixes the circuitry that handles record representation
clauses so that a component clause for an inherited component in
a record extension is properly rejected (such a clause is illegal
per 13.5.1(9)).

The following compilation must be rejected with the indicated error:
$ gcc -c illegal_clause_for_inherited_comp.ads 
illegal_clause_for_inherited_comp.ads:7:08: component clause not allowed for inherited component "B"

package Illegal_Clause_For_Inherited_Comp is
  type R1 is tagged record
    B  : Boolean;
  end record;
  type R1_Ext is new R1 with null record;
  for R1_Ext use record
    B  at 2 range 63 .. 63;
  end record;
end;

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

2013-01-03  Thomas Quinot  <quinot@adacore.com>

	* sem_ch13.adb (Analyze_Record_Representation_Clause): Reject
	an illegal component clause for an inherited component in a
	record extension.

Patch

Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 194847)
+++ sem_ch13.adb	(working copy)
@@ -4663,10 +4663,34 @@ 
       Ocomp   : Entity_Id;
       Posit   : Uint;
       Rectype : Entity_Id;
+      Recdef  : Node_Id;
 
+      function Is_Inherited (Comp : Entity_Id) return Boolean;
+      --  True if Comp is an inherited component in a record extension
+
+      ------------------
+      -- Is_Inherited --
+      ------------------
+
+      function Is_Inherited (Comp : Entity_Id) return Boolean is
+         Comp_Base : Entity_Id;
+      begin
+         if Ekind (Rectype) = E_Record_Subtype then
+            Comp_Base := Original_Record_Component (Comp);
+         else
+            Comp_Base := Comp;
+         end if;
+         return Comp_Base /= Original_Record_Component (Comp_Base);
+      end Is_Inherited;
+
+      Is_Record_Extension : Boolean;
+      --  True if Rectype is a record extension
+
       CR_Pragma : Node_Id := Empty;
       --  Points to N_Pragma node if Complete_Representation pragma present
 
+   --  Start of processing for Analyze_Record_Representation_Clause
+
    begin
       if Ignore_Rep_Clauses then
          return;
@@ -4706,6 +4730,14 @@ 
          return;
       end if;
 
+      --  We know we have a first subtype, now possibly go the the anonymous
+      --  base type to determine whether Rectype is a record extension.
+
+      Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype)));
+      Is_Record_Extension :=
+        Nkind (Recdef) = N_Derived_Type_Definition
+          and then Present (Record_Extension_Part (Recdef));
+
       if Present (Mod_Clause (N)) then
          declare
             Loc     : constant Source_Ptr := Sloc (N);
@@ -4881,6 +4913,11 @@ 
                        ("cannot reference discriminant of unchecked union",
                         Component_Name (CC));
 
+                  elsif Is_Record_Extension and then Is_Inherited (Comp) then
+                     Error_Msg_NE
+                       ("component clause not allowed for inherited "
+                        & "component&", CC, Comp);
+
                   elsif Present (Component_Clause (Comp)) then
 
                      --  Diagnose duplicate rep clause, or check consistency
@@ -4908,10 +4945,11 @@ 
                               Error_Msg_N
                                 ("component clause inconsistent "
                                  & "with representation of ancestor", CC);
+
                            elsif Warn_On_Redundant_Constructs then
                               Error_Msg_N
-                                ("?r?redundant component clause "
-                                 & "for inherited component!", CC);
+                                ("?r?redundant confirming component clause "
+                                 & "for component!", CC);
                            end if;
                         end;
                      end if;
@@ -7346,7 +7384,7 @@ 
       begin
          if Present (CC1) and then Present (CC2) then
 
-            --  Exclude odd case where we have two tag fields in the same
+            --  Exclude odd case where we have two tag components in the same
             --  record, both at location zero. This seems a bit strange, but
             --  it seems to happen in some circumstances, perhaps on an error.
 
@@ -7387,7 +7425,7 @@ 
       procedure Find_Component is
 
          procedure Search_Component (R : Entity_Id);
-         --  Search components of R for a match. If found, Comp is set.
+         --  Search components of R for a match. If found, Comp is set
 
          ----------------------
          -- Search_Component --
@@ -7426,8 +7464,8 @@ 
 
          Search_Component (Rectype);
 
-         --  If not found, maybe component of base type that is absent from
-         --  statically constrained first subtype.
+         --  If not found, maybe component of base type discriminant that is
+         --  absent from statically constrained first subtype.
 
          if No (Comp) then
             Search_Component (Base_Type (Rectype));
@@ -7555,7 +7593,7 @@ 
                  ("bit number out of range of specified size",
                   Last_Bit (CC));
 
-               --  Check for overlap with tag field
+               --  Check for overlap with tag component
 
             else
                if Is_Tagged_Type (Rectype)