+2017-01-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * ghost.ads, ghost.adb (Is_Ignored_Ghost_Unit): New routine.
+ * gnat1drv.adb Generate an empty object file for an ignored
+ Ghost compilation unit.
+ * inline.adb, sem_util.adb, sem_ch4.adb: Minor reformatting.
+
2017-01-23 Yannick Moy <moy@adacore.com>
* sem_ch4.adb (Analyze_Indexed_Component_Form):
return False;
end Is_Ghost_Procedure_Call;
+ ---------------------------
+ -- Is_Ignored_Ghost_Unit --
+ ---------------------------
+
+ function Is_Ignored_Ghost_Unit (N : Node_Id) return Boolean is
+ begin
+ -- Inspect the original node of the unit in case removal of ignored
+ -- Ghost code has already taken place.
+
+ return
+ Nkind (N) = N_Compilation_Unit
+ and then Is_Ignored_Ghost_Entity
+ (Defining_Entity (Original_Node (Unit (N))));
+ end Is_Ignored_Ghost_Unit;
+
-------------------------
-- Is_Subject_To_Ghost --
-------------------------
begin
-- Do not prune compilation unit nodes because many mechanisms
- -- depend on their presence. Note that context items must still
- -- be processed.
+ -- depend on their presence. Note that context items are still
+ -- being processed.
if Nkind (N) = N_Compilation_Unit then
return OK;
-- Determine whether arbitrary node N denotes a procedure call invoking a
-- Ghost procedure.
+ function Is_Ignored_Ghost_Unit (N : Node_Id) return Boolean;
+ -- Determine whether compilation unit N is subject to pragma Ghost with
+ -- policy Ignore.
+
procedure Lock;
-- Lock internal tables before calling backend
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Frontend;
-with Ghost;
+with Ghost; use Ghost;
with Gnatvsn; use Gnatvsn;
with Inline;
with Lib; use Lib;
-- Local variables
Back_End_Mode : Back_End.Back_End_Mode_Type;
+ Ecode : Exit_Code_Type;
Main_Unit_Kind : Node_Kind;
-- Kind of main compilation unit node
-- it must not produce an ALI or object file. Do not emit any errors
-- related to code generation because the unit does not exist.
- if Main_Unit_Kind = N_Null_Statement
- and then Is_Ignored_Ghost_Node
- (Original_Node (Unit (Main_Unit_Node)))
- then
- null;
+ if Is_Ignored_Ghost_Unit (Main_Unit_Node) then
+
+ -- Exit the gnat driver with success, otherwise external builders
+ -- such as gnatmake and gprbuild will treat the compilation of an
+ -- ignored Ghost unit as a failure. Note that this will produce
+ -- an empty object file for the unit.
+
+ Ecode := E_Success;
-- Otherwise the unit is missing a crucial piece that prevents code
-- generation.
else
+ Ecode := E_No_Code;
+
Set_Standard_Error;
Write_Str ("cannot generate code for file ");
Write_Name (Unit_File_Name (Main_Unit));
Namet.Finalize;
Check_Rep_Info;
- -- Exit program with error indication, to kill object file
+ -- Exit the driver with an appropriate status indicator. This will
+ -- generate an empty object file for ignored Ghost units, otherwise
+ -- no object file will be generated.
- Exit_Program (E_No_Code);
+ Exit_Program (Ecode);
end if;
-- In -gnatc mode, we only do annotation if -gnatt or -gnatR is also set
-----------------------------------------
function Has_Single_Return_In_GNATprove_Mode return Boolean is
- Last_Statement : Node_Id := Empty;
Body_To_Inline : constant Node_Id := N;
+ Last_Statement : Node_Id := Empty;
function Check_Return (N : Node_Id) return Traverse_Result;
-- Returns OK on node N if this is not a return statement different
function Check_Return (N : Node_Id) return Traverse_Result is
begin
case Nkind (N) is
- when N_Simple_Return_Statement
- | N_Extended_Return_Statement
+ when N_Extended_Return_Statement
+ | N_Simple_Return_Statement
=>
if N = Last_Statement then
return OK;
-- In GNATprove mode, keep the most precise type of the actual for
-- the temporary variable, when the formal type is unconstrained.
-- Otherwise, the AST may contain unexpected assignment statements
- -- to a temporary variable of unconstrained type renaming a
- -- local variable of constrained type, which is not expected
- -- by GNATprove.
+ -- to a temporary variable of unconstrained type renaming a local
+ -- variable of constrained type, which is not expected by
+ -- GNATprove.
elsif Etype (F) /= Etype (A)
and then (not GNATprove_Mode or else Is_Constrained (Etype (F)))
Analyze (Exp);
Set_Etype (N, Any_Type);
- if not Has_Compatible_Type
- (Exp, Entry_Index_Type (Pent))
- then
+ if not Has_Compatible_Type (Exp, Entry_Index_Type (Pent)) then
Error_Msg_N ("invalid index type in entry name", N);
elsif Present (Next (Exp)) then
New_Scope : Entity_Id := Empty) return Node_Id
is
Actual_Map : Elist_Id := Map;
- -- This is the actual map for the copy. It is initialized with the
- -- given elements, and then enlarged as required for Itypes that are
- -- copied during the first phase of the copy operation. The visit
- -- procedures add elements to this map as Itypes are encountered.
- -- The reason we cannot use Map directly, is that it may well be
- -- (and normally is) initialized to No_Elist, and if we have mapped
- -- entities, we have to reset it to point to a real Elist.
+ -- This is the actual map for the copy. It is initialized with the given
+ -- elements, and then enlarged as required for Itypes that are copied
+ -- during the first phase of the copy operation. The visit procedures
+ -- add elements to this map as Itypes are encountered. The reason we
+ -- cannot use Map directly, is that it may well be (and normally is)
+ -- initialized to No_Elist, and if we have mapped entities, we have to
+ -- reset it to point to a real Elist.
NCT_Hash_Threshold : constant := 20;
-- If there are more than this number of pairs of entries in the map,
-- phase, the tree is copied, using the replacement map to replace any
-- Itype references within the copied tree.
- -- The following hash tables are used if the Map supplied has more
- -- than hash threshold entries to speed up access to the map. If
- -- there are fewer entries, then the map is searched sequentially
- -- (because setting up a hash table for only a few entries takes
- -- more time than it saves.
+ -- The following hash tables are used if the Map supplied has more than
+ -- hash threshold entries to speed up access to the map. If there are
+ -- fewer entries, then the map is searched sequentially (because setting
+ -- up a hash table for only a few entries takes more time than it saves.
subtype NCT_Header_Num is Int range 0 .. 511;
-- Defines range of headers in hash tables (512 headers)
projects / gcc.git / commitdiff