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 <ebotca...@adacore.com>
* sem_ch13.adb (Check_Record_Representation_Clause): Give an
error as soon as one of the specified components overlaps the
parent field.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 251784)
+++ sem_ch13.adb (working copy)
@@ -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);
