From dafe11cd1851fecb7b7bc780410be394fc99142a Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Mon, 23 Jan 2017 13:28:58 +0000 Subject: [PATCH] ghost.ads, ghost.adb (Is_Ignored_Ghost_Unit): New routine. 2017-01-23 Hristian Kirtchev * 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. From-SVN: r244808 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/ghost.adb | 19 +++++++++++++++++-- gcc/ada/ghost.ads | 4 ++++ gcc/ada/gnat1drv.adb | 24 ++++++++++++++++-------- gcc/ada/inline.adb | 12 ++++++------ gcc/ada/sem_ch4.adb | 4 +--- gcc/ada/sem_util.adb | 23 +++++++++++------------ 7 files changed, 62 insertions(+), 31 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bbd19a11492..b396520ced4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2017-01-23 Hristian Kirtchev + + * 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 * sem_ch4.adb (Analyze_Indexed_Component_Form): diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index f40e8ea55f4..ec4c1d646c4 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -940,6 +940,21 @@ package body Ghost is 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 -- ------------------------- @@ -1603,8 +1618,8 @@ package body Ghost is 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; diff --git a/gcc/ada/ghost.ads b/gcc/ada/ghost.ads index 1e57183322a..e0211c02f10 100644 --- a/gcc/ada/ghost.ads +++ b/gcc/ada/ghost.ads @@ -94,6 +94,10 @@ package Ghost is -- 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 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 057dc9e2a6b..30ccd610437 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -36,7 +36,7 @@ with Fmap; 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; @@ -919,6 +919,7 @@ procedure Gnat1drv is -- 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 @@ -1265,16 +1266,21 @@ begin -- 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)); @@ -1335,9 +1341,11 @@ begin 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 diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 4e8dd7d8842..78d921a75d7 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -958,8 +958,8 @@ package body Inline is ----------------------------------------- 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 @@ -972,8 +972,8 @@ package body Inline is 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; @@ -3166,9 +3166,9 @@ package body Inline is -- 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))) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 50fe00cccf1..1cdb7a03288 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2419,9 +2419,7 @@ package body Sem_Ch4 is 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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5f5d3773109..40a72f7c9ae 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16227,13 +16227,13 @@ package body Sem_Util is 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, @@ -16265,11 +16265,10 @@ package body Sem_Util is -- 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) -- 2.30.2