===================================================================
@@ -9806,12 +9806,12 @@
-- checking for overlap, since no overlap is possible.
Tagged_Parent : Entity_Id := Empty;
- -- This is set in the case of a derived tagged type for which we have
- -- Is_Fully_Repped_Tagged_Type True (indicating that all components are
- -- positioned by record representation clauses). In this case we must
- -- check for overlap between components of this tagged type, and the
- -- components of its parent. Tagged_Parent will point to this parent
- -- type. For all other cases Tagged_Parent is left set to Empty.
+ -- This is set in the case of an extension for which we have either a
+ -- size clause or Is_Fully_Repped_Tagged_Type True (indicating that all
+ -- components are positioned by record representation clauses) on the
+ -- parent type. In this case we check for overlap between components of
+ -- this tagged type and the parent component. Tagged_Parent will point
+ -- to this parent type. For all other cases, Tagged_Parent is Empty.
Parent_Last_Bit : Uint;
-- Relevant only if Tagged_Parent is set, Parent_Last_Bit indicates the
@@ -9959,19 +9959,23 @@
if Rectype = Any_Type then
return;
- else
- Rectype := Underlying_Type (Rectype);
end if;
+ Rectype := Underlying_Type (Rectype);
+
-- See if we have a fully repped derived tagged type
declare
PS : constant Entity_Id := Parent_Subtype (Rectype);
begin
- if Present (PS) and then Is_Fully_Repped_Tagged_Type (PS) then
+ if Present (PS) and then Known_Static_RM_Size (PS) then
Tagged_Parent := PS;
+ Parent_Last_Bit := RM_Size (PS) - 1;
+ elsif Present (PS) and then Is_Fully_Repped_Tagged_Type (PS) then
+ Tagged_Parent := PS;
+
-- Find maximum bit of any component of the parent type
Parent_Last_Bit := UI_From_Int (System_Address_Size - 1);
@@ -10063,7 +10067,7 @@
("bit number out of range of specified size",
Last_Bit (CC));
- -- Check for overlap with tag component
+ -- Check for overlap with tag or parent component
else
if Is_Tagged_Type (Rectype)
@@ -10073,27 +10077,20 @@
("component overlaps tag field of&",
Component_Name (CC), Rectype);
Overlap_Detected := True;
+
+ elsif Present (Tagged_Parent)
+ and then Fbit <= Parent_Last_Bit
+ then
+ Error_Msg_NE
+ ("component overlaps parent field of&",
+ Component_Name (CC), Rectype);
+ Overlap_Detected := True;
end if;
if Hbit < Lbit then
Hbit := Lbit;
end if;
end if;
-
- -- Check parent overlap if component might overlap parent field
-
- if Present (Tagged_Parent) and then Fbit <= Parent_Last_Bit then
- Pcomp := First_Component_Or_Discriminant (Tagged_Parent);
- while Present (Pcomp) loop
- if not Is_Tag (Pcomp)
- and then Chars (Pcomp) /= Name_uParent
- then
- Check_Component_Overlap (Comp, Pcomp);
- end if;
-
- Next_Component_Or_Discriminant (Pcomp);
- end loop;
- end if;
end if;
Next (CC);
This makes the compiler generate an error message also in the case where one of the specified components overlaps the parent field because its size has been explicitly set by a size clause. The compiler must issue an error on 32-bit platforms for the package: 1. package P is 2. 3. type Byte is mod 2**8; 4. for Byte'Size use 8; 5. 6. type Root is tagged record 7. Status : Byte; 8. end record; 9. for Root use record 10. Status at 4 range 0 .. 7; 11. end record; 12. for Root'Size use 64; 13. 14. type Ext is new Root with record 15. Thread_Status : Byte; 16. end record; 17. for Ext use record 18. Thread_Status at 5 range 0 .. 7; | >>> component overlaps parent field of "Ext" 19. end record; 20. 21. end P; 21 lines: 1 error Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Eric Botcazou <ebotcazou@adacore.com> * sem_ch13.adb (Check_Record_Representation_Clause): Give an error as soon as one of the specified components overlaps the parent field.