2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* ghost.adb (Mark_Ghost_Clause): New routine.
(Prune_Node): Do not prune compilation unit nodes.
(Remove_Ignored_Ghost_Code): Prune the compilation unit node directly.
This does not touch the node itself, but does prune all its fields.
* ghost.ads (Mark_Ghost_Clause): New routine.
* sem_ch8.adb (Analyze_Use_Package): Emit an error when a use
package clause mentions Ghost and non-Ghost packages. Mark a
use package clause as Ghost when it mentions a Ghost package.
(Analyze_Use_Type): Emit an error when a use type clause mentions
Ghost and non-Ghost types. Mark a use type clause as Ghost when
it mentions a Ghost type.
* sem_ch10.adb (Analyze_With_Clause): Mark a with clause as
Ghost when it withs a Ghost unit.
2017-01-20 Javier Miranda <miranda@adacore.com>
* sem_res.adb (Resolve_Call): If a function call
returns a limited view of a type and at the point of the call the
function is not declared in the extended main unit then replace
it with the non-limited view, which must be available. If the
called function is in the extended main unit then no action is
needed since the back-end handles this case.
2017-01-20 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch7.adb (Contains_Subp_Or_Const_Refs): Rename into...
(Contains_Subprograms_Refs): ...this. Adjust comment
for constants. (Is_Subp_Or_Const_Ref): Rename into...
(Is_Subprogram_Ref): ...this.
(Has_Referencer): Rename Has_Non_Subp_Const_Referencer variable into
Has_Non_Subprograms_Referencer and adjust comment. Remove
incorrect shortcut for package declarations and bodies.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): If the scope of the
base type differs from that of the completion and the private
subtype is an itype (created for a constraint on an access
type e.g.), set Delayed_Freeze on both to prevent out-of-scope
anomalies in gigi.
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper):
When inheriting the SPARK_Mode of a prior expression function,
look at the properly resolved entity rather than the initial
candidate which may denote a homonym.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Rewrite_Assertion_Kind): If the name is
Precondition or Postcondition, and the context is pragma
Check_Policy, indicate that this Pre-
Ada2012 usage is deprecated
and suggest the standard names Assertion_Policy /Pre /Post
instead.
From-SVN: r244704
+2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * ghost.adb (Mark_Ghost_Clause): New routine.
+ (Prune_Node): Do not prune compilation unit nodes.
+ (Remove_Ignored_Ghost_Code): Prune the compilation unit node directly.
+ This does not touch the node itself, but does prune all its fields.
+ * ghost.ads (Mark_Ghost_Clause): New routine.
+ * sem_ch8.adb (Analyze_Use_Package): Emit an error when a use
+ package clause mentions Ghost and non-Ghost packages. Mark a
+ use package clause as Ghost when it mentions a Ghost package.
+ (Analyze_Use_Type): Emit an error when a use type clause mentions
+ Ghost and non-Ghost types. Mark a use type clause as Ghost when
+ it mentions a Ghost type.
+ * sem_ch10.adb (Analyze_With_Clause): Mark a with clause as
+ Ghost when it withs a Ghost unit.
+
+2017-01-20 Javier Miranda <miranda@adacore.com>
+
+ * sem_res.adb (Resolve_Call): If a function call
+ returns a limited view of a type and at the point of the call the
+ function is not declared in the extended main unit then replace
+ it with the non-limited view, which must be available. If the
+ called function is in the extended main unit then no action is
+ needed since the back-end handles this case.
+
+2017-01-20 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_ch7.adb (Contains_Subp_Or_Const_Refs): Rename into...
+ (Contains_Subprograms_Refs): ...this. Adjust comment
+ for constants. (Is_Subp_Or_Const_Ref): Rename into...
+ (Is_Subprogram_Ref): ...this.
+ (Has_Referencer): Rename Has_Non_Subp_Const_Referencer variable into
+ Has_Non_Subprograms_Referencer and adjust comment. Remove
+ incorrect shortcut for package declarations and bodies.
+
+2017-01-20 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Complete_Private_Subtype): If the scope of the
+ base type differs from that of the completion and the private
+ subtype is an itype (created for a constraint on an access
+ type e.g.), set Delayed_Freeze on both to prevent out-of-scope
+ anomalies in gigi.
+
+2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper):
+ When inheriting the SPARK_Mode of a prior expression function,
+ look at the properly resolved entity rather than the initial
+ candidate which may denote a homonym.
+
+2017-01-20 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb (Rewrite_Assertion_Kind): If the name is
+ Precondition or Postcondition, and the context is pragma
+ Check_Policy, indicate that this Pre-Ada2012 usage is deprecated
+ and suggest the standard names Assertion_Policy /Pre /Post
+ instead.
+
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch10.adb, sem_cat.adb: Minor reformatting.
end if;
end Mark_Ghost_Declaration_Or_Body;
+ -----------------------
+ -- Mark_Ghost_Clause --
+ -----------------------
+
+ procedure Mark_Ghost_Clause (N : Node_Id) is
+ Nam : Node_Id := Empty;
+
+ begin
+ if Nkind (N) = N_Use_Package_Clause then
+ Nam := First (Names (N));
+
+ elsif Nkind (N) = N_Use_Type_Clause then
+ Nam := First (Subtype_Marks (N));
+
+ elsif Nkind (N) = N_With_Clause then
+ Nam := Name (N);
+ end if;
+
+ if Present (Nam)
+ and then Is_Entity_Name (Nam)
+ and then Present (Entity (Nam))
+ and then Is_Ignored_Ghost_Entity (Entity (Nam))
+ then
+ Set_Is_Ignored_Ghost_Node (N);
+ Propagate_Ignored_Ghost_Code (N);
+ end if;
+ end Mark_Ghost_Clause;
+
-----------------------
-- Mark_Ghost_Pragma --
-----------------------
Id : Entity_Id;
begin
+ -- Do not prune compilation unit nodes because many mechanisms
+ -- depend on their presence. Note that context items must still
+ -- be processed.
+
+ if Nkind (N) = N_Compilation_Unit then
+ return OK;
+
-- The node is either declared as ignored Ghost or is a byproduct
-- of expansion. Destroy it and stop the traversal on this branch.
- if Is_Ignored_Ghost_Node (N) then
+ elsif Is_Ignored_Ghost_Node (N) then
Prune (N);
return Skip;
begin
for Index in Ignored_Ghost_Units.First .. Ignored_Ghost_Units.Last loop
- Prune_Tree (Unit (Ignored_Ghost_Units.Table (Index)));
+ Prune_Tree (Ignored_Ghost_Units.Table (Index));
end loop;
end Remove_Ignored_Ghost_Code;
-- prior to processing the procedure call. This routine starts a Ghost
-- region and must be used in conjunction with Restore_Ghost_Mode.
+ procedure Mark_Ghost_Clause (N : Node_Id);
+ -- Mark use package, use type, or with clause N as Ghost when:
+ --
+ -- * The clause mentions a Ghost entity
+
procedure Mark_Ghost_Pragma
(N : Node_Id;
Id : Entity_Id);
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Freeze; use Freeze;
+with Ghost; use Ghost;
with Impunit; use Impunit;
with Inline; use Inline;
with Lib; use Lib;
Set_Fatal_Error (Current_Sem_Unit, Error_Ignored);
end if;
end case;
+
+ Mark_Ghost_Clause (N);
end Analyze_With_Clause;
------------------------------
-- already frozen. We skip this processing if the type is an anonymous
-- subtype of a record component, or is the corresponding record of a
-- protected type, since these are processed when the enclosing type
- -- is frozen.
+ -- is frozen. If the parent type is declared in a nested package then
+ -- the freezing of the private and full views also happens later.
if not Is_Type (Scope (Full)) then
- Set_Has_Delayed_Freeze (Full,
- Has_Delayed_Freeze (Full_Base)
- and then (not Is_Frozen (Full_Base)));
+ if Is_Itype (Priv)
+ and then In_Same_Source_Unit (Full, Full_Base)
+ and then Scope (Full_Base) /= Scope (Full)
+ then
+ Set_Has_Delayed_Freeze (Full);
+ Set_Has_Delayed_Freeze (Priv);
+
+ else
+ Set_Has_Delayed_Freeze (Full,
+ Has_Delayed_Freeze (Full_Base)
+ and then (not Is_Frozen (Full_Base)));
+ end if;
end if;
Set_Freeze_Node (Full, Empty);
-- end P; -- mode is ON
elsif not Comes_From_Source (N)
- and then Present (Prev_Id)
- and then Is_Expression_Function (Prev_Id)
+ and then Present (Spec_Id)
+ and then Is_Expression_Function (Spec_Id)
then
- Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Prev_Id));
+ Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Spec_Id));
Set_SPARK_Pragma_Inherited
- (Body_Id, SPARK_Pragma_Inherited (Prev_Id));
+ (Body_Id, SPARK_Pragma_Inherited (Spec_Id));
-- Set the SPARK_Mode from the current context (may be overwritten later
-- with explicit pragma). Exclude the case where the SPARK_Mode appears
--------------------------
procedure Hide_Public_Entities (Decls : List_Id) is
- function Contains_Subp_Or_Const_Refs (N : Node_Id) return Boolean;
+ function Contains_Subprograms_Refs (N : Node_Id) return Boolean;
-- Subsidiary to routine Has_Referencer. Determine whether a node
- -- contains a reference to a subprogram or a non-static constant.
+ -- contains a reference to a subprogram.
-- WARNING: this is a very expensive routine as it performs a full
-- tree traversal.
-- in the range Last (Decls) .. Referencer are hidden from external
-- visibility.
- ---------------------------------
- -- Contains_Subp_Or_Const_Refs --
- ---------------------------------
+ -------------------------------
+ -- Contains_Subprograms_Refs --
+ -------------------------------
- function Contains_Subp_Or_Const_Refs (N : Node_Id) return Boolean is
+ function Contains_Subprograms_Refs (N : Node_Id) return Boolean is
Reference_Seen : Boolean := False;
- function Is_Subp_Or_Const_Ref
- (N : Node_Id) return Traverse_Result;
- -- Determine whether a node denotes a reference to a subprogram or
- -- a non-static constant.
+ function Is_Subprogram_Ref (N : Node_Id) return Traverse_Result;
+ -- Determine whether a node denotes a reference to a subprogram
- --------------------------
- -- Is_Subp_Or_Const_Ref --
- --------------------------
+ -----------------------
+ -- Is_Subprogram_Ref --
+ -----------------------
- function Is_Subp_Or_Const_Ref
+ function Is_Subprogram_Ref
(N : Node_Id) return Traverse_Result
is
Val : Node_Id;
Reference_Seen := True;
return Abandon;
- -- Detect the use of a non-static constant
+ -- Constants can be substituted by their value in gigi, which
+ -- may contain a reference, so be conservative for them.
elsif Is_Entity_Name (N)
and then Present (Entity (N))
end if;
return OK;
- end Is_Subp_Or_Const_Ref;
+ end Is_Subprogram_Ref;
- procedure Find_Subp_Or_Const_Ref is
- new Traverse_Proc (Is_Subp_Or_Const_Ref);
+ procedure Find_Subprograms_Ref is
+ new Traverse_Proc (Is_Subprogram_Ref);
- -- Start of processing for Contains_Subp_Or_Const_Refs
+ -- Start of processing for Contains_Subprograms_Refs
begin
- Find_Subp_Or_Const_Ref (N);
+ Find_Subprograms_Ref (N);
return Reference_Seen;
- end Contains_Subp_Or_Const_Refs;
+ end Contains_Subprograms_Refs;
--------------------
-- Has_Referencer --
Decl_Id : Entity_Id;
Spec : Node_Id;
- Has_Non_Subp_Const_Referencer : Boolean := False;
- -- Flag set for inlined subprogram bodies that do not contain
- -- references to other subprograms or non-static constants.
+ Has_Non_Subprograms_Referencer : Boolean := False;
+ -- Flag set if a subprogram body was detected as a referencer but
+ -- does not contain references to other subprograms. In this case,
+ -- if we still are top level, we do not return True immediately,
+ -- but keep hiding subprograms from external visibility.
begin
if No (Decls) then
-- Package declaration
- elsif Nkind (Decl) = N_Package_Declaration
- and then not Has_Non_Subp_Const_Referencer
- then
+ elsif Nkind (Decl) = N_Package_Declaration then
Spec := Specification (Decl);
-- Inspect the declarations of a non-generic package to try
-- Inspect the declarations of a non-generic package body to
-- try and hide more entities from external visibility.
- elsif not Has_Non_Subp_Const_Referencer
- and then Has_Referencer (Declarations (Decl))
- then
+ elsif Has_Referencer (Declarations (Decl)) then
return True;
end if;
then
-- Inspect the statements of the subprogram body
-- to determine whether the body references other
- -- subprograms and/or non-static constants.
+ -- subprograms.
if Top_Level
- and then not Contains_Subp_Or_Const_Refs (Decl)
+ and then not Contains_Subprograms_Refs (Decl)
then
- Has_Non_Subp_Const_Referencer := True;
+ Has_Non_Subprograms_Referencer := True;
else
return True;
end if;
if Has_Pragma_Inline (Decl_Id) then
if Top_Level
- and then not Contains_Subp_Or_Const_Refs (Decl)
+ and then not Contains_Subprograms_Refs (Decl)
then
- Has_Non_Subp_Const_Referencer := True;
+ Has_Non_Subprograms_Referencer := True;
else
return True;
end if;
-- if they are not followed by a construct which can reference
-- and export them. The Is_Public flag is reset on top level
-- entities only as anything nested is local to its context.
+ -- Likewise for subprograms, but we work harder for them as
+ -- their visibility can have a significant impact on inlining
+ -- decisions in the back end.
elsif Nkind_In (Decl, N_Exception_Declaration,
N_Object_Declaration,
and then not Is_Exported (Decl_Id)
and then No (Interface_Name (Decl_Id))
and then
- (not Has_Non_Subp_Const_Referencer
+ (not Has_Non_Subprograms_Referencer
or else Nkind (Decl) = N_Subprogram_Declaration)
then
Set_Is_Public (Decl_Id, False);
Prev (Decl);
end loop;
- return Has_Non_Subp_Const_Referencer;
+ return Has_Non_Subprograms_Referencer;
end Has_Referencer;
-- Local variables
-- within the package itself, ignore it.
procedure Analyze_Use_Package (N : Node_Id) is
- Pack_Name : Node_Id;
+ Ghost_Id : Entity_Id := Empty;
+ Living_Id : Entity_Id := Empty;
Pack : Entity_Id;
-
- -- Start of processing for Analyze_Use_Package
+ Pack_Name : Node_Id;
begin
Check_SPARK_05_Restriction ("use clause is not allowed", N);
if Entity (Pref) = Standard_Standard then
Error_Msg_N
- ("predefined package Standard cannot appear"
- & " in a context clause", Pref);
+ ("predefined package Standard cannot appear in a context "
+ & "clause", Pref);
end if;
end;
end if;
Next (Pack_Name);
end loop;
- -- Loop through package names to mark all entities as potentially
- -- use visible.
+ -- Loop through package names to mark all entities as potentially use
+ -- visible.
Pack_Name := First (Names (N));
while Present (Pack_Name) loop
if Applicable_Use (Pack_Name) then
Use_One_Package (Pack, N);
end if;
+
+ -- Capture the first Ghost package and the first living package
+
+ if Is_Entity_Name (Pack_Name) then
+ Pack := Entity (Pack_Name);
+
+ if Is_Ghost_Entity (Pack) then
+ if No (Ghost_Id) then
+ Ghost_Id := Pack;
+ end if;
+
+ elsif No (Living_Id) then
+ Living_Id := Pack;
+ end if;
+ end if;
end if;
-- Report error because name denotes something other than a package
Next (Pack_Name);
end loop;
+
+ -- Detect a mixture of Ghost packages and living packages within the
+ -- same use package clause. Ideally one would split a use package clause
+ -- with multiple names into multiple use package clauses with a single
+ -- name, however clients of the front end would have to adapt to this
+ -- change.
+
+ if Present (Ghost_Id) and then Present (Living_Id) then
+ Error_Msg_N
+ ("use clause cannot mention ghost and non-ghost ghost units", N);
+
+ Error_Msg_Sloc := Sloc (Ghost_Id);
+ Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
+
+ Error_Msg_Sloc := Sloc (Living_Id);
+ Error_Msg_NE ("\& # declared as non-ghost", N, Living_Id);
+ end if;
+
+ Mark_Ghost_Clause (N);
end Analyze_Use_Package;
----------------------
----------------------
procedure Analyze_Use_Type (N : Node_Id) is
- E : Entity_Id;
- Id : Node_Id;
+ E : Entity_Id;
+ Ghost_Id : Entity_Id := Empty;
+ Id : Node_Id;
+ Living_Id : Entity_Id := Empty;
begin
Set_Hidden_By_Use_Clause (N, No_Elist);
end if;
end if;
+ -- Capture the first Ghost type and the first living type
+
+ if Is_Ghost_Entity (E) then
+ if No (Ghost_Id) then
+ Ghost_Id := E;
+ end if;
+
+ elsif No (Living_Id) then
+ Living_Id := E;
+ end if;
+
Next (Id);
end loop;
+
+ -- Detect a mixture of Ghost types and living types within the same use
+ -- type clause. Ideally one would split a use type clause with multiple
+ -- marks into multiple use type clauses with a single mark, however
+ -- clients of the front end will have to adapt to this change.
+
+ if Present (Ghost_Id) and then Present (Living_Id) then
+ Error_Msg_N
+ ("use clause cannot mention ghost and non-ghost ghost types", N);
+
+ Error_Msg_Sloc := Sloc (Ghost_Id);
+ Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
+
+ Error_Msg_Sloc := Sloc (Living_Id);
+ Error_Msg_NE ("\& # declared as non-ghost", N, Living_Id);
+ end if;
+
+ Mark_Ghost_Clause (N);
end Analyze_Use_Type;
--------------------
-- function, this routine finds the corresponding state and sets the entity
-- of N to that of the state.
- procedure Rewrite_Assertion_Kind (N : Node_Id);
+ procedure Rewrite_Assertion_Kind
+ (N : Node_Id;
+ From_Policy : Boolean := False);
-- If N is Pre'Class, Post'Class, Invariant'Class, or Type_Invariant'Class,
-- then it is rewritten as an identifier with the corresponding special
-- name _Pre, _Post, _Invariant, or _Type_Invariant. Used by pragmas Check
- -- and Check_Policy.
+ -- and Check_Policy. If the names are Precondition or Postcondition, this
+ -- combination is deprecated in favor of Assertion_Policy and Ada2012
+ -- Aspect names. The parameter From_Policy indicates that the pragma
+ -- is the old non-standard Check_Policy and not a rewritten pragma.
procedure Set_Elab_Unit_Name (N : Node_Id; With_Item : Node_Id);
-- Place semantic information on the argument of an Elaborate/Elaborate_All
Check_Arg_Count (2);
Check_Optional_Identifier (Arg1, Name_Name);
Kind := Get_Pragma_Arg (Arg1);
- Rewrite_Assertion_Kind (Kind);
+ Rewrite_Assertion_Kind (Kind,
+ From_Policy => Comes_From_Source (N));
Check_Arg_Is_Identifier (Arg1);
-- Check forbidden check kind
-- Rewrite_Assertion_Kind --
----------------------------
- procedure Rewrite_Assertion_Kind (N : Node_Id) is
+ procedure Rewrite_Assertion_Kind
+ (N : Node_Id;
+ From_Policy : Boolean := False)
+ is
Nam : Name_Id;
begin
+ Nam := No_Name;
if Nkind (N) = N_Attribute_Reference
and then Attribute_Name (N) = Name_Class
and then Nkind (Prefix (N)) = N_Identifier
return;
end case;
+ -- Recommend standard use of aspect names Pre/Post
+
+ elsif Nkind (N) = N_Identifier
+ and then From_Policy
+ and then Serious_Errors_Detected = 0
+ and then not ASIS_Mode
+ then
+ if Chars (N) = Name_Precondition
+ or else Chars (N) = Name_Postcondition
+ then
+ Error_Msg_N (" Check_Policy is a non-standard pragma??", N);
+ Error_Msg_N
+ (" \use Assertion_Policy and aspect names Pre/Post"
+ & " for Ada2012 conformance?", N);
+ end if;
+ return;
+ end if;
+
+ if Nam /= No_Name then
Rewrite (N, Make_Identifier (Sloc (N), Chars => Nam));
end if;
end Rewrite_Assertion_Kind;
end;
else
- -- If the function returns the limited view of type, the call must
- -- appear in a context in which the non-limited view is available.
- -- As is done in Try_Object_Operation, use the available view to
- -- prevent back-end confusion.
-
- if From_Limited_With (Etype (Nam)) then
+ -- If the called function is not declared in the main unit and it
+ -- returns the limited view of type then use the available view (as
+ -- is done in Try_Object_Operation) to prevent back-end confusion;
+ -- the call must appear in a context where the nonlimited view is
+ -- available. If the called function is in the extended main unit
+ -- then no action is needed, because the back end handles this case.
+
+ if not In_Extended_Main_Code_Unit (Nam)
+ and then From_Limited_With (Etype (Nam))
+ then
Set_Etype (Nam, Available_View (Etype (Nam)));
end if;
projects / gcc.git / commitdiff