Error_Msg_N ("\??use explicit size clause to set size", E);
end if;
- -- Declaring a too-big array in disabled ghost code is OK
+ -- Declaring too big an array in disabled ghost code is OK
+
if Is_Array_Type (Typ) and then not Is_Ignored_Ghost_Entity (E) then
Check_Large_Modular_Array (Typ);
end if;
-- clause (used to warn about useless Bit_Order pragmas, and also
-- to detect cases where Implicit_Packing may have an effect).
- Rec_Pushed : Boolean := False;
- -- Set True if the record type scope Rec has been pushed on the scope
- -- stack. Needed for the analysis of delayed aspects specified to the
- -- components of Rec.
-
Sized_Component_Total_RM_Size : Uint := Uint_0;
-- Accumulates total RM_Size values of all sized components. Used
-- for processing of Implicit_Packing.
-- Start of processing for Freeze_Record_Type
begin
- -- Deal with delayed aspect specifications for components. The
- -- analysis of the aspect is required to be delayed to the freeze
- -- point, thus we analyze the pragma or attribute definition
- -- clause in the tree at this point. We also analyze the aspect
- -- specification node at the freeze point when the aspect doesn't
- -- correspond to pragma/attribute definition clause.
-
- Comp := First_Entity (Rec);
- while Present (Comp) loop
- if Ekind (Comp) = E_Component
- and then Has_Delayed_Aspects (Comp)
- then
- if not Rec_Pushed then
- Push_Scope (Rec);
- Rec_Pushed := True;
-
- -- The visibility to the discriminants must be restored in
- -- order to properly analyze the aspects.
-
- if Has_Discriminants (Rec) then
- Install_Discriminants (Rec);
- end if;
- end if;
-
- Analyze_Aspects_At_Freeze_Point (Comp);
- end if;
-
- Next_Entity (Comp);
- end loop;
-
- -- Pop the scope if Rec scope has been pushed on the scope stack
- -- during the delayed aspect analysis process.
-
- if Rec_Pushed then
- if Has_Discriminants (Rec) then
- Uninstall_Discriminants (Rec);
- end if;
-
- Pop_Scope;
- end if;
-
-- Freeze components and embedded subtypes
Comp := First_Entity (Rec);
-- In addition, a derived type may have inherited aspects that were
-- delayed in the parent, so these must also be captured now.
+ -- For a record type, we deal with the delayed aspect specifications on
+ -- components first, which is consistent with the non-delayed case and
+ -- makes it possible to have a single processing to detect conflicts.
+
+ if Is_Record_Type (E) then
+ declare
+ Comp : Entity_Id;
+
+ Rec_Pushed : Boolean := False;
+ -- Set True if the record type E has been pushed on the scope
+ -- stack. Needed for the analysis of delayed aspects specified
+ -- to the components of Rec.
+
+ begin
+ Comp := First_Entity (E);
+ while Present (Comp) loop
+ if Ekind (Comp) = E_Component
+ and then Has_Delayed_Aspects (Comp)
+ then
+ if not Rec_Pushed then
+ Push_Scope (E);
+ Rec_Pushed := True;
+
+ -- The visibility to the discriminants must be restored
+ -- in order to properly analyze the aspects.
+
+ if Has_Discriminants (E) then
+ Install_Discriminants (E);
+ end if;
+ end if;
+
+ Analyze_Aspects_At_Freeze_Point (Comp);
+ end if;
+
+ Next_Entity (Comp);
+ end loop;
+
+ -- Pop the scope if Rec scope has been pushed on the scope stack
+ -- during the delayed aspect analysis process.
+
+ if Rec_Pushed then
+ if Has_Discriminants (E) then
+ Uninstall_Discriminants (E);
+ end if;
+
+ Pop_Scope;
+ end if;
+ end;
+ end if;
+
if Has_Delayed_Aspects (E)
or else May_Inherit_Delayed_Rep_Aspects (E)
then
procedure Check_At_Most_N_Arguments (N : Nat);
-- Check there are no more than N arguments present
+ procedure Check_Atomic_VFA (E : Entity_Id; VFA : Boolean);
+ -- Apply legality checks to type or object E subject to an Atomic aspect
+ -- in Ada 2020 (RM C.6(13)) or to a Volatile_Full_Access aspect.
+
procedure Check_Component
(Comp : Node_Id;
UU_Typ : Entity_Id;
end if;
end Check_At_Most_N_Arguments;
+ ------------------------
+ -- Check_Atomic_VFA --
+ ------------------------
+
+ procedure Check_Atomic_VFA (E : Entity_Id; VFA : Boolean) is
+
+ Aliased_Subcomponent : exception;
+ -- Exception raised if an aliased subcomponent is found in E
+
+ Independent_Subcomponent : exception;
+ -- Exception raised if an independent subcomponent is found in E
+
+ procedure Check_Subcomponents (Typ : Entity_Id);
+ -- Apply checks to subcomponents for Atomic and Volatile_Full_Access
+
+ -------------------------
+ -- Check_Subcomponents --
+ -------------------------
+
+ procedure Check_Subcomponents (Typ : Entity_Id) is
+ Comp : Entity_Id;
+
+ begin
+ if Is_Array_Type (Typ) then
+ Comp := Component_Type (Typ);
+
+ -- For Atomic we accept any atomic subcomponents
+
+ if not VFA
+ and then (Has_Atomic_Components (Typ)
+ or else Is_Atomic (Comp))
+ then
+ null;
+
+ -- Give an error if the components are aliased
+
+ elsif Has_Aliased_Components (Typ)
+ or else Is_Aliased (Comp)
+ then
+ raise Aliased_Subcomponent;
+
+ -- For VFA we accept non-aliased VFA subcomponents
+
+ elsif VFA
+ and then Is_Volatile_Full_Access (Comp)
+ then
+ null;
+
+ -- Give an error if the components are independent
+
+ elsif Has_Independent_Components (Typ)
+ or else Is_Independent (Comp)
+ then
+ raise Independent_Subcomponent;
+ end if;
+
+ -- Recurse on the component type
+
+ Check_Subcomponents (Comp);
+
+ -- 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
+
+ -- For Atomic we accept any atomic subcomponents
+
+ if not VFA
+ and then (Is_Atomic (Comp)
+ or else Is_Atomic (Etype (Comp)))
+ then
+ null;
+
+ -- Give an error if the component is aliased
+
+ elsif Is_Aliased (Comp)
+ or else Is_Aliased (Etype (Comp))
+ then
+ raise Aliased_Subcomponent;
+
+ -- For VFA we accept non-aliased VFA subcomponents
+
+ elsif VFA
+ and then (Is_Volatile_Full_Access (Comp)
+ or else Is_Volatile_Full_Access (Etype (Comp)))
+ then
+ null;
+
+ -- Give an error if the component is independent
+
+ elsif Is_Independent (Comp)
+ or else Is_Independent (Etype (Comp))
+ then
+ raise Independent_Subcomponent;
+ end if;
+
+ -- Recurse on the component type
+
+ Check_Subcomponents (Etype (Comp));
+
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+ end if;
+ end Check_Subcomponents;
+
+ Typ : Entity_Id;
+
+ begin
+ -- Fetch the type in case we are dealing with an object or component
+
+ if Is_Type (E) then
+ Typ := E;
+ else
+ pragma Assert (Is_Object (E)
+ or else
+ Nkind (Declaration_Node (E)) = N_Component_Declaration);
+
+ Typ := Etype (E);
+ end if;
+
+ -- Check all the subcomponents of the type recursively, if any
+
+ Check_Subcomponents (Typ);
+
+ exception
+ when Aliased_Subcomponent =>
+ if VFA then
+ Error_Pragma
+ ("cannot apply Volatile_Full_Access with aliased "
+ & "subcomponent ");
+ else
+ Error_Pragma
+ ("cannot apply Atomic with aliased subcomponent "
+ & "(RM C.6(13))");
+ end if;
+
+ when Independent_Subcomponent =>
+ if VFA then
+ Error_Pragma
+ ("cannot apply Volatile_Full_Access with independent "
+ & "subcomponent ");
+ else
+ Error_Pragma
+ ("cannot apply Atomic with independent subcomponent "
+ & "(RM C.6(13))");
+ end if;
+
+ when others =>
+ raise Program_Error;
+ end Check_Atomic_VFA;
+
---------------------
-- Check_Component --
---------------------
procedure Process_Atomic_Independent_Shared_Volatile is
procedure Check_VFA_Conflicts (Ent : Entity_Id);
- -- Apply additional checks for the GNAT pragma Volatile_Full_Access
+ -- Check that Volatile_Full_Access and VFA do not conflict
procedure Mark_Component_Or_Object (Ent : Entity_Id);
- -- Appropriately set flags on the given entity (either an array or
+ -- Appropriately set flags on the given entity, either an array or
-- record component, or an object declaration) according to the
-- current pragma.
+ procedure Mark_Type (Ent : Entity_Id);
+ -- Appropriately set flags on the given entity, a type
+
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
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
+ -- Set True if both VFA and Atomic present
begin
-- Fetch the type in case we are dealing with an object or
& "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;
------------------------------
end if;
end Mark_Component_Or_Object;
+ ---------------
+ -- Mark_Type --
+ ---------------
+
+ procedure Mark_Type (Ent : Entity_Id) is
+ begin
+ -- Attribute belongs on the base type. If the view of the type is
+ -- 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
+ then
+ Set_Atomic_VFA (Ent);
+ Set_Atomic_VFA (Base_Type (Ent));
+ Set_Atomic_VFA (Underlying_Type (Ent));
+ end if;
+
+ -- Atomic/Shared/Volatile_Full_Access imply Independent
+
+ if Prag_Id /= Pragma_Volatile then
+ Set_Is_Independent (Ent);
+ Set_Is_Independent (Base_Type (Ent));
+ Set_Is_Independent (Underlying_Type (Ent));
+
+ if Prag_Id = Pragma_Independent then
+ Record_Independence_Check (N, Base_Type (Ent));
+ end if;
+ end if;
+
+ -- Atomic/Shared/Volatile_Full_Access imply Volatile
+
+ if Prag_Id /= Pragma_Independent then
+ Set_Is_Volatile (Ent);
+ Set_Is_Volatile (Base_Type (Ent));
+ Set_Is_Volatile (Underlying_Type (Ent));
+
+ Set_Treat_As_Volatile (Ent);
+ Set_Treat_As_Volatile (Underlying_Type (Ent));
+ end if;
+
+ -- Apply Volatile to the composite type's individual components,
+ -- (RM C.6(8/3)).
+
+ if Prag_Id = Pragma_Volatile
+ and then Is_Record_Type (Etype (Ent))
+ then
+ declare
+ Comp : Entity_Id;
+ begin
+ Comp := First_Component (Ent);
+ while Present (Comp) loop
+ Mark_Component_Or_Object (Comp);
+
+ Next_Component (Comp);
+ end loop;
+ end;
+ end if;
+ end Mark_Type;
+
--------------------
-- Set_Atomic_VFA --
--------------------
Check_First_Subtype (Arg1);
end if;
- -- Attribute belongs on the base type. If the view of the type is
- -- 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
- then
- Set_Atomic_VFA (E);
- Set_Atomic_VFA (Base_Type (E));
- Set_Atomic_VFA (Underlying_Type (E));
- end if;
-
- -- Atomic/Shared/Volatile_Full_Access imply Independent
-
- if Prag_Id /= Pragma_Volatile then
- Set_Is_Independent (E);
- Set_Is_Independent (Base_Type (E));
- Set_Is_Independent (Underlying_Type (E));
-
- if Prag_Id = Pragma_Independent then
- Record_Independence_Check (N, Base_Type (E));
- end if;
- end if;
-
- -- Atomic/Shared/Volatile_Full_Access imply Volatile
-
- if Prag_Id /= Pragma_Independent then
- Set_Is_Volatile (E);
- Set_Is_Volatile (Base_Type (E));
- Set_Is_Volatile (Underlying_Type (E));
-
- Set_Treat_As_Volatile (E);
- Set_Treat_As_Volatile (Underlying_Type (E));
- end if;
-
- -- Apply Volatile to the composite type's individual components,
- -- (RM C.6(8/3)).
-
- if Prag_Id = Pragma_Volatile
- and then Is_Record_Type (Etype (E))
- then
- declare
- Comp : Entity_Id;
- begin
- Comp := First_Component (E);
- while Present (Comp) loop
- Mark_Component_Or_Object (Comp);
-
- Next_Component (Comp);
- end loop;
- end;
- end if;
+ Mark_Type (E);
-- Deal with the case where the pragma/attribute applies to a
-- component or object declaration.
end if;
Mark_Component_Or_Object (E);
+
+ -- In other cases give an error
+
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 that Volatile_Full_Access and Atomic do not conflict
Check_VFA_Conflicts (E);
+ -- Check for the application of Atomic or Volatile_Full_Access to
+ -- an entity that has [nonatomic] aliased, or else specified to be
+ -- independently addressable, subcomponents.
+
+ if (Prag_Id = Pragma_Atomic and then Ada_Version >= Ada_2020)
+ or else Prag_Id = Pragma_Volatile_Full_Access
+ then
+ Check_Atomic_VFA (E, VFA => Prag_Id = Pragma_Volatile_Full_Access);
+ end if;
+
-- 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
-- Atomic implies both Independent and Volatile
if Prag_Id = Pragma_Atomic_Components then
+ if Ada_Version >= Ada_2020 then
+ Check_Atomic_VFA (Component_Type (E), VFA => False);
+ end if;
Set_Has_Atomic_Components (E);
Set_Has_Independent_Components (E);
end if;
projects / gcc.git / commitdiff