This patch corrects an issue where attributes applied to records were not
propagated to components within the records - causing incorrect code to be
generated by the backend. Additionally, this ticket fixes another issue with
pragma Volatile_Full_Access that allowed the attribute to be applied to a type
with aliased components.
------------
-- Source --
------------
-- p.ads
with System; use System;
package P is
type Int8_t is mod 2**8;
type Rec is record
A,B,C,D : aliased Int8_t;
end record;
type VFA_Rec is new Rec with Volatile_Full_Access; -- ERROR
R : Rec with Volatile_Full_Access; -- ERROR
type Arr is array (1 .. 4) of aliased Int8_t;
type VFA_Arr is new Arr with Volatile_Full_Access; -- ERROR
A : Arr with Volatile_Full_Access; -- ERROR
type Priv_VFA_Rec is private
with Volatile_Full_Access; -- ERROR
type Priv_Ind_Rec is private
with Independent; -- ERROR
type Priv_Vol_Rec is private
with Volatile; -- ERROR
type Priv_Atomic_Rec is private
with Atomic; -- ERROR
type Aliased_Rec is tagged record
X : aliased Integer;
end record with Volatile_Full_Access; -- OK
type Atomic_And_VFA_Int is new Integer
with Atomic, Volatile_Full_Access; -- ERROR
type Atomic_And_VFA_Rec is record
X : Integer with Atomic;
end record with Volatile_Full_Access; -- ERROR
type Atomic_T is tagged record
X : Integer with Atomic; -- OK
end record;
type Atomic_And_VFA_T is new Atomic_T with record
Y : Integer;
end record with Volatile_Full_Access; -- ERROR
type Aliased_And_VFA_T is new Aliased_Rec with record
Y : Integer;
end record with Volatile_Full_Access; -- ERROR
Aliased_And_VFA_Obj : aliased Integer with Volatile_Full_Access; -- ERROR
Atomic_And_VFA_Obj : Integer with Atomic, Volatile_Full_Access; -- ERROR
Aliased_And_VFA_Obj_B : Aliased_Rec with Volatile_Full_Access; -- ERROR
Atomic_And_VFA_Obj_B : Atomic_T with Volatile_Full_Access; -- ERROR
private
type Priv_VFA_Rec is record
X : Integer;
end record;
type Priv_Ind_Rec is record
X : Integer;
end record;
type Priv_Vol_Rec is record
X : Integer;
end record;
type Priv_Atomic_Rec is record
X : Integer;
end record;
end;
-- p2.adb
with System;
procedure P2 is
type Type1_T is record
Field_1 : Integer;
Field_2 : Integer;
Field_3 : Integer;
Field_4 : Short_Integer;
end record;
for Type1_T use record
Field_1 at 0 range 0 .. 31;
Field_2 at 4 range 0 .. 31;
Field_3 at 8 range 0 .. 31;
Field_4 at 12 range 0 .. 15;
end record;
for Type1_T'Size use (14) * System.Storage_Unit;
pragma Volatile(Type1_T);
type Type2_T is record
Type1 : Type1_T;
Field_1 : Integer;
Field_2 : Integer;
Field_3 : Integer;
Field_4 : Short_Integer;
end record;
for Type2_T use record
Type1 at 0 range 0 .. 111;
Field_1 at 14 range 0 .. 31;
Field_2 at 18 range 0 .. 31;
Field_3 at 22 range 0 .. 31;
Field_4 at 26 range 0 .. 15;
end record;
for Type2_T'Size use (28) * System.Storage_Unit;
pragma Volatile(Type2_T); -- ERROR
Type1 : Type1_T := (0,0,0,0);
Type2 : Type2_T:= ((0,0,0,0),0,0,0,0);
begin
Type1.Field_1 := Type1.Field_1 +1;
Type2.Field_1 := Type2.Field_1 +1;
end;
----------------------------
-- Compilation and output --
----------------------------
& gcc -c p.ads
& gnatmake -q p2.adb
p.ads:8:33: cannot apply Volatile_Full_Access (aliased component present)
p.ads:10:17: cannot apply Volatile_Full_Access (aliased component present)
p.ads:13:33: cannot apply Volatile_Full_Access (aliased component present)
p.ads:15:17: cannot apply Volatile_Full_Access (aliased component present)
p.ads:18:11: representation item must be after full type declaration
p.ads:21:11: representation item must be after full type declaration
p.ads:24:11: representation item must be after full type declaration
p.ads:27:11: representation item must be after full type declaration
p.ads:31:20: cannot apply Volatile_Full_Access (aliased component present)
p.ads:34:19: cannot have Volatile_Full_Access and Atomic for same entity
p.ads:38:20: cannot have Volatile_Full_Access and Atomic for same entity
p.ads:46:20: cannot have Volatile_Full_Access and Atomic for same entity
p.ads:50:20: cannot apply Volatile_Full_Access (aliased component present)
p.ads:53:49: cannot have Volatile_Full_Access and Atomic for same entity
p.ads:54:45: cannot apply Volatile_Full_Access (aliased component present)
p.ads:55:42: cannot have Volatile_Full_Access and Atomic for same entity
p2.adb:30:31: size of volatile field "Type1" must be at least 128 bits
p2.adb:31:27: position of volatile field "Field_1" must be multiple of 32 bits
p2.adb:32:27: position of volatile field "Field_2" must be multiple of 32 bits
p2.adb:33:27: position of volatile field "Field_3" must be multiple of 32 bits
p2.adb:36:30: size for "Type2_T" too small, minimum allowed is 448
gnatmake: "p2.adb" compilation error
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-06 Justin Squirek <squi...@adacore.com>
* sem_prag.adb (Check_VFA_Conflicts): Created
to group all Volatile_Full_Access checks relating to other
representation pragmas (Mark_Component_Or_Object): Created
to centeralize the flagging of attributes for the record type
component case, a pragma applied individually to a component, and
the object case.
(Process_Atomic_Independent_Shared_Volatile):
Add propagation of certain pragmas to record components and move
evaluation of VFA checks
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 251789)
+++ sem_prag.adb (working copy)
@@ -6873,26 +6873,193 @@
------------------------------------------------
procedure Process_Atomic_Independent_Shared_Volatile is
- procedure Set_Atomic_VFA (E : Entity_Id);
+ procedure Check_VFA_Conflicts (Ent : Entity_Id);
+ -- Apply additional checks for the GNAT pragma Volatile_Full_Access
+
+ procedure Mark_Component_Or_Object (Ent : Entity_Id);
+ -- Appropriately set flags on the given entity (either an array or
+ -- record component, or an object declaration) according to the
+ -- current pragma.
+
+ procedure Set_Atomic_VFA (Ent : Entity_Id);
-- Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if
-- no explicit alignment was given, set alignment to unknown, since
-- back end knows what the alignment requirements are for atomic and
-- full access arrays. Note: this is necessary for derived types.
+ -------------------------
+ -- Check_VFA_Conflicts --
+ -------------------------
+
+ procedure Check_VFA_Conflicts (Ent : Entity_Id) is
+ Comp : Entity_Id;
+ Typ : Entity_Id;
+
+ VFA_And_Atomic : Boolean := False;
+ -- Set True if atomic component present
+
+ VFA_And_Aliased : Boolean := False;
+ -- Set True if aliased component present
+
+ begin
+ -- Fetch the type in case we are dealing with an object or
+ -- component.
+
+ if Is_Type (Ent) then
+ Typ := Ent;
+ else
+ pragma Assert (Is_Object (Ent)
+ or else
+ Nkind (Declaration_Node (Ent)) = N_Component_Declaration);
+
+ Typ := Etype (Ent);
+ end if;
+
+ -- Check Atomic and VFA used together
+
+ if Prag_Id = Pragma_Volatile_Full_Access
+ or else Is_Volatile_Full_Access (Ent)
+ then
+ if Prag_Id = Pragma_Atomic
+ or else Prag_Id = Pragma_Shared
+ or else Is_Atomic (Ent)
+ then
+ VFA_And_Atomic := True;
+
+ elsif Is_Array_Type (Typ) then
+ VFA_And_Atomic := Has_Atomic_Components (Typ);
+
+ -- Note: Has_Atomic_Components is not used below, as this flag
+ -- represents the pragma of the same name, Atomic_Components,
+ -- which only applies to arrays.
+
+ elsif Is_Record_Type (Typ) then
+ -- Attributes cannot be applied to discriminants, only
+ -- regular record components.
+
+ Comp := First_Component (Typ);
+ while Present (Comp) loop
+ if Is_Atomic (Comp)
+ or else Is_Atomic (Typ)
+ then
+ VFA_And_Atomic := True;
+
+ exit;
+ end if;
+
+ Next_Component (Comp);
+ end loop;
+ end if;
+
+ if VFA_And_Atomic then
+ Error_Pragma
+ ("cannot have Volatile_Full_Access and Atomic for same "
+ & "entity");
+ end if;
+ end if;
+
+ -- Check for the application of VFA to an entity that has aliased
+ -- components.
+
+ if Prag_Id = Pragma_Volatile_Full_Access then
+ if Is_Array_Type (Typ)
+ and then Has_Aliased_Components (Typ)
+ then
+ VFA_And_Aliased := True;
+
+ -- Note: Has_Aliased_Components, like Has_Atomic_Components,
+ -- and Has_Independent_Components, applies only to arrays.
+ -- However, this flag does not have a corresponding pragma, so
+ -- perhaps it should be possible to apply it to record types as
+ -- well. Should this be done ???
+
+ elsif Is_Record_Type (Typ) then
+ -- It is possible to have an aliased discriminant, so they
+ -- must be checked along with normal components.
+
+ Comp := First_Component_Or_Discriminant (Typ);
+ while Present (Comp) loop
+ if Is_Aliased (Comp)
+ or else Is_Aliased (Etype (Comp))
+ then
+ VFA_And_Aliased := True;
+ Check_SPARK_05_Restriction
+ ("aliased is not allowed", Comp);
+
+ exit;
+ end if;
+
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+ end if;
+
+ if VFA_And_Aliased then
+ Error_Pragma
+ ("cannot apply Volatile_Full_Access (aliased component "
+ & "present)");
+ end if;
+ end if;
+ end Check_VFA_Conflicts;
+
+ ------------------------------
+ -- Mark_Component_Or_Object --
+ ------------------------------
+
+ procedure Mark_Component_Or_Object (Ent : Entity_Id) is
+ begin
+ if Prag_Id = Pragma_Atomic
+ or else Prag_Id = Pragma_Shared
+ or else Prag_Id = Pragma_Volatile_Full_Access
+ then
+ if Prag_Id = Pragma_Volatile_Full_Access then
+ Set_Is_Volatile_Full_Access (Ent);
+ else
+ Set_Is_Atomic (Ent);
+ end if;
+
+ -- If the object declaration has an explicit initialization, a
+ -- temporary may have to be created to hold the expression, to
+ -- ensure that access to the object remains atomic.
+
+ if Nkind (Parent (Ent)) = N_Object_Declaration
+ and then Present (Expression (Parent (Ent)))
+ then
+ Set_Has_Delayed_Freeze (Ent);
+ end if;
+ end if;
+
+ -- Atomic/Shared/Volatile_Full_Access imply Independent
+
+ if Prag_Id /= Pragma_Volatile then
+ Set_Is_Independent (Ent);
+
+ if Prag_Id = Pragma_Independent then
+ Record_Independence_Check (N, Ent);
+ end if;
+ end if;
+
+ -- Atomic/Shared/Volatile_Full_Access imply Volatile
+
+ if Prag_Id /= Pragma_Independent then
+ Set_Is_Volatile (Ent);
+ Set_Treat_As_Volatile (Ent);
+ end if;
+ end Mark_Component_Or_Object;
+
--------------------
-- Set_Atomic_VFA --
--------------------
- procedure Set_Atomic_VFA (E : Entity_Id) is
+ procedure Set_Atomic_VFA (Ent : Entity_Id) is
begin
if Prag_Id = Pragma_Volatile_Full_Access then
- Set_Is_Volatile_Full_Access (E);
+ Set_Is_Volatile_Full_Access (Ent);
else
- Set_Is_Atomic (E);
+ Set_Is_Atomic (Ent);
end if;
- if not Has_Alignment_Clause (E) then
- Set_Alignment (E, Uint_0);
+ if not Has_Alignment_Clause (Ent) then
+ Set_Alignment (Ent, Uint_0);
end if;
end Set_Atomic_VFA;
@@ -6926,63 +7093,15 @@
Check_Duplicate_Pragma (E);
- -- Check Atomic and VFA used together
+ -- Check appropriateness of the entity
- if (Is_Atomic (E) and then Prag_Id = Pragma_Volatile_Full_Access)
- or else (Is_Volatile_Full_Access (E)
- and then (Prag_Id = Pragma_Atomic
- or else
- Prag_Id = Pragma_Shared))
- then
- Error_Pragma
- ("cannot have Volatile_Full_Access and Atomic for same entity");
- end if;
+ Decl := Declaration_Node (E);
- -- Check for applying VFA to an entity which has aliased component
+ -- Deal with the case where the pragma/attribute is applied to a type
- if Prag_Id = Pragma_Volatile_Full_Access then
- declare
- Comp : Entity_Id;
- Aliased_Comp : Boolean := False;
- -- Set True if aliased component present
-
- begin
- if Is_Array_Type (Etype (E)) then
- Aliased_Comp := Has_Aliased_Components (Etype (E));
-
- -- Record case, too bad Has_Aliased_Components is not also
- -- set for records, should it be ???
-
- elsif Is_Record_Type (Etype (E)) then
- Comp := First_Component_Or_Discriminant (Etype (E));
- while Present (Comp) loop
- if Is_Aliased (Comp)
- or else Is_Aliased (Etype (Comp))
- then
- Aliased_Comp := True;
- exit;
- end if;
-
- Next_Component_Or_Discriminant (Comp);
- end loop;
- end if;
-
- if Aliased_Comp then
- Error_Pragma
- ("cannot apply Volatile_Full_Access (aliased component "
- & "present)");
- end if;
- end;
- end if;
-
- -- Now check appropriateness of the entity
-
- Decl := Declaration_Node (E);
-
if Is_Type (E) then
if Rep_Item_Too_Early (E, N)
- or else
- Rep_Item_Too_Late (E, N)
+ or else Rep_Item_Too_Late (E, N)
then
return;
else
@@ -6993,10 +7112,8 @@
-- currently private, it also belongs on the underlying type.
if Prag_Id = Pragma_Atomic
- or else
- Prag_Id = Pragma_Shared
- or else
- Prag_Id = Pragma_Volatile_Full_Access
+ or else Prag_Id = Pragma_Shared
+ or else Prag_Id = Pragma_Volatile_Full_Access
then
Set_Atomic_VFA (E);
Set_Atomic_VFA (Base_Type (E));
@@ -7026,6 +7143,9 @@
Set_Treat_As_Volatile (Underlying_Type (E));
end if;
+ -- Deal with the case where the pragma/attribute applies to a
+ -- component or object declaration.
+
elsif Nkind (Decl) = N_Object_Declaration
or else (Nkind (Decl) = N_Component_Declaration
and then Original_Record_Component (E) = E)
@@ -7034,50 +7154,16 @@
return;
end if;
- if Prag_Id = Pragma_Atomic
- or else
- Prag_Id = Pragma_Shared
- or else
- Prag_Id = Pragma_Volatile_Full_Access
- then
- if Prag_Id = Pragma_Volatile_Full_Access then
- Set_Is_Volatile_Full_Access (E);
- else
- Set_Is_Atomic (E);
- end if;
-
- -- If the object declaration has an explicit initialization, a
- -- temporary may have to be created to hold the expression, to
- -- ensure that access to the object remain atomic.
-
- if Nkind (Parent (E)) = N_Object_Declaration
- and then Present (Expression (Parent (E)))
- then
- Set_Has_Delayed_Freeze (E);
- end if;
- end if;
-
- -- Atomic/Shared/Volatile_Full_Access imply Independent
-
- if Prag_Id /= Pragma_Volatile then
- Set_Is_Independent (E);
-
- if Prag_Id = Pragma_Independent then
- Record_Independence_Check (N, E);
- end if;
- end if;
-
- -- Atomic/Shared/Volatile_Full_Access imply Volatile
-
- if Prag_Id /= Pragma_Independent then
- Set_Is_Volatile (E);
- Set_Treat_As_Volatile (E);
- end if;
-
+ Mark_Component_Or_Object (E);
else
Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
end if;
+ -- Perform the checks needed to assure the proper use of the GNAT
+ -- pragma Volatile_Full_Access.
+
+ Check_VFA_Conflicts (E);
+
-- The following check is only relevant when SPARK_Mode is on as
-- this is not a standard Ada legality rule. Pragma Volatile can
-- only apply to a full type declaration or an object declaration
