+2017-09-06 Ed Schonberg <schonberg@adacore.com>
+
+ * checks.adb (Apply_Predicate_Check): If the expression is an
+ aggregate that is the RHS of an assignment, apply the check to
+ the LHS after the assignment, rather than to the aggregate. This
+ is more efficient than creating a temporary for the aggregate,
+ and prevents back-end crashes when the aggregate includes a
+ dynamic "others' association.
+
+2017-09-06 Yannick Moy <moy@adacore.com>
+
+ * sem_ch12.adb (Analyze_Instance_And_Renamings):
+ Set variable to ignore SPARK_Mode in instance before the analysis
+ of the generated package declaration.
+
+2017-09-06 Yannick Moy <moy@adacore.com>
+
+ * sem_res.adb (Resolve_Call): Do not issue a
+ message for calls inside expression function, unless body was
+ seen and is candidate for inlining.
+
+2017-09-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_aux.adb (Is_Generic_Formal): Handle properly formal packages.
+ * sem_ch3.adb (Analyze_Declarations): In a generic subprogram
+ body. do not freeze the formals of the generic unit.
+
+2017-09-06 Gary Dismukes <dismukes@adacore.com>
+
+ * errout.adb (Error_Msg): Separate the
+ treatment for warning vs. style messages in inlinings and
+ instantiations. Prevents blowups on calls to Warn_Insertion for
+ style messages, which should not be called in that case because
+ Warning_Msg_Char is not set.
+
+2017-09-06 Justin Squirek <squirek@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
+
2017-09-06 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Check_Postcondition_Use_In_Inlined_Subprogram):
------------------------------------------------
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;
Check_Duplicate_Pragma (E);
- -- Check Atomic and VFA used together
-
- 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;
-
- -- Check for applying VFA to an entity which has aliased component
-
- 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
+ -- Check appropriateness of the entity
Decl := Declaration_Node (E);
+ -- Deal with the case where the pragma/attribute is applied to a type
+
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
-- 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));
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)
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
projects / gcc.git / commitdiff