+2016-04-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Analyze_Selected_Component, Has_Dereference):
+ Refine check on illegal calls to entities within a task body,
+ when the entity is declared in an object of the same type. In
+ a generic context there might be no explicit dereference but if
+ the prefix includes an access type the construct is legal.
+
+2016-04-18 Arnaud Charlet <charlet@adacore.com>
+
+ * rtsfind.ads, rtsfind.adb (RE_Id, RE_Unit_Table): add
+ RE_Default_Priority.
+
+2016-04-18 Bob Duff <duff@adacore.com>
+
+ * sem_prag.adb (Check_Arg_Is_Local_Name): Don't do the check
+ if the pragma came from an aspect specification.
+
+2016-04-18 Gary Dismukes <dismukes@adacore.com>
+
+ * gnat1drv.adb, contracts.adb: Minor reformatting and wording fixes.
+
+2016-04-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper): To suppress
+ superfluous conformance check on an inlined body with a previous
+ spec, use the fact that the generated declaration does not come
+ from source. We must treat the entity as coming from source to
+ enable some back-end inlining when pragma appears after the body.
+
2016-04-18 Gary Dismukes <dismukes@adacore.com>
* lib-xref-spark_specific.adb, par-ch2.adb, errout.ads,
-- The insertion node after which all pragma Check equivalents are
-- inserted.
+ function Is_Prologue_Renaming (Decl : Node_Id) return Boolean;
+ -- Determine whether arbitrary declaration Decl denotes a renaming of
+ -- a discriminant or protection field _object.
+
procedure Merge_Preconditions (From : Node_Id; Into : Node_Id);
-- Merge two class-wide preconditions by "or else"-ing them. The
-- changes are accumulated in parameter Into. Update the error
-- Collect all preconditions of subprogram Subp_Id and prepend their
-- pragma Check equivalents to the declarations of the body.
+ --------------------------
+ -- Is_Prologue_Renaming --
+ --------------------------
+
+ function Is_Prologue_Renaming (Decl : Node_Id) return Boolean is
+ Nam : Node_Id;
+ Obj : Entity_Id;
+ Pref : Node_Id;
+ Sel : Node_Id;
+
+ begin
+ if Nkind (Decl) = N_Object_Renaming_Declaration then
+ Obj := Defining_Entity (Decl);
+ Nam := Name (Decl);
+
+ if Nkind (Nam) = N_Selected_Component then
+ Pref := Prefix (Nam);
+ Sel := Selector_Name (Nam);
+
+ -- A discriminant renaming appears as
+ -- Discr : constant ... := Prefix.Discr;
+
+ if Ekind (Obj) = E_Constant
+ and then Is_Entity_Name (Sel)
+ and then Present (Entity (Sel))
+ and then Ekind (Entity (Sel)) = E_Discriminant
+ then
+ return True;
+
+ -- A protection field renaming appears as
+ -- Prot : ... := _object._object;
+
+ elsif Ekind (Obj) = E_Variable
+ and then Nkind (Pref) = N_Identifier
+ and then Chars (Pref) = Name_uObject
+ and then Nkind (Sel) = N_Identifier
+ and then Chars (Sel) = Name_uObject
+ then
+ return True;
+ end if;
+ end if;
+ end if;
+
+ return False;
+ end Is_Prologue_Renaming;
+
-------------------------
-- Merge_Preconditions --
-------------------------
-- Start of processing for Process_Preconditions
begin
- -- Find the last internally generated declaration, starting from the
- -- top of the body declarations. This ensures that discriminals and
- -- subtypes are properly visible to the pragma Check equivalents.
+ -- Find the proper insertion point for all pragma Check equivalents
if Present (Decls) then
Decl := First (Decls);
while Present (Decl) loop
- exit when Comes_From_Source (Decl);
- Insert_Node := Decl;
+
+ -- First source declaration terminates the search, because all
+ -- preconditions must be evaluated prior to it, by definition.
+
+ if Comes_From_Source (Decl) then
+ exit;
+
+ -- Certain internally generated object renamings such as those
+ -- for discriminants and protection fields must be elaborated
+ -- before the preconditions are evaluated, as their expressions
+ -- may mention the discriminants.
+
+ elsif Is_Prologue_Renaming (Decl) then
+ Insert_Node := Decl;
+
+ -- Otherwise the declaration does not come from source. This
+ -- also terminates the search, because internal code may raise
+ -- exceptions which should not preempt the preconditions.
+
+ else
+ exit;
+ end if;
+
Next (Decl);
end loop;
end if;
-- In GNATprove mode, force loading of System unit to ensure that
-- System.Interrupt_Priority is available to GNATprove for the
- -- generation of VCs for related to Ceiling Priority.
+ -- generation of VCs related to ceiling priority.
if GNATprove_Mode then
declare
RE_Address, -- System
RE_Any_Priority, -- System
RE_Bit_Order, -- System
+ RE_Default_Priority, -- System
RE_High_Order_First, -- System
RE_Interrupt_Priority, -- System
RE_Lib_Stop, -- System
RE_Address => System,
RE_Any_Priority => System,
RE_Bit_Order => System,
+ RE_Default_Priority => System,
RE_High_Order_First => System,
RE_Interrupt_Priority => System,
RE_Lib_Stop => System,
if Nkind (Nod) = N_Explicit_Dereference then
return True;
+ -- When expansion is disabled an explicit dereference may not have
+ -- been inserted, but if this is an access type the indirection makes
+ -- the call safe.
+
+ elsif Is_Access_Type (Etype (Nod)) then
+ return True;
+
elsif Nkind_In (Nod, N_Indexed_Component, N_Selected_Component) then
return Has_Dereference (Prefix (Nod));
Conformant := True;
-- Conversely, the spec may have been generated for specless body
- -- with an inline pragma.
+ -- with an inline pragma. The entity comes from source, which is
+ -- both semantically correct and necessary for proper inlining.
+ -- The subprogram declaration itself is not in the source.
elsif Comes_From_Source (N)
- and then not Comes_From_Source (Spec_Id)
+ and then Present (Spec_Decl)
+ and then not Comes_From_Source (Spec_Decl)
and then Has_Pragma_Inline (Spec_Id)
then
Conformant := True;
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
begin
+ -- If this pragma came from an aspect specification, we don't want to
+ -- check for this error, because that would cause spurious errors, in
+ -- case a type is frozen in a scope more nested than the type. The
+ -- aspect itself of course can't be anywhere but on the declaration
+ -- itself.
+
+ if Nkind (Arg) = N_Pragma_Argument_Association then
+ if From_Aspect_Specification (Parent (Arg)) then
+ return;
+ end if;
+
+ -- Arg is the Expression of an N_Pragma_Argument_Association
+
+ else
+ if From_Aspect_Specification (Parent (Parent (Arg))) then
+ return;
+ end if;
+ end if;
+
Analyze (Argx);
if Nkind (Argx) not in N_Direct_Name
projects / gcc.git / commitdiff