This patch modifies the front end to prevent the generation of ALI and object files as well as bypass the back end and suppress any errors related to code generation when the compilation unit is ignored Ghost.
------------ -- Source -- ------------ -- ignore.adc pragma Assertion_Policy (Ghost => Ignore); -- ghost_gen.adb with Ada.Text_IO; use Ada.Text_IO; package body Ghost_Gen is procedure Ghost_Proc (Formal : T) is begin if Formal = Ghost_Obj then null; end if; Put_Line ("ERROR: Ghost_Gen"); end Ghost_Proc; end Ghost_Gen; -- ghost_gen.ads generic type T is private; Ghost_Obj : T; package Ghost_Gen with Ghost is procedure Ghost_Proc (Formal : T); end Ghost_Gen; -- ghost_pack_spec.ads package Ghost_Pack_Spec with Ghost is Ghost_Obj : constant Integer := 1; end Ghost_Pack_Spec; -- ghost_pack_spec_and_body.adb with Ada.Text_IO; use Ada.Text_IO; package body Ghost_Pack_Spec_And_Body is procedure Ghost_Proc (Formal : Integer) is begin if Ghost_Obj = Formal then null; end if; Put_Line ("ERROR: Ghost_Pack_Spec_And_Body"); end Ghost_Proc; end Ghost_Pack_Spec_And_Body; -- ghost_pack_spec_and_body.ads package Ghost_Pack_Spec_And_Body with Ghost is Ghost_Obj : constant Integer := 1; procedure Ghost_Proc (Formal : Integer); end Ghost_Pack_Spec_And_Body; -- ghost_subp_body.adb with Ada.Text_IO; use Ada.Text_IO; procedure Ghost_Subp_Body (Formal : Integer) with Ghost is Ghost_Obj : Integer := 1; begin if Ghost_Obj = Formal then null; end if; Put_Line ("ERROR: Ghost_Subp_Body"); end Ghost_Subp_Body; -- ghost_subp_spec_and_body.adb with Ada.Text_IO; use Ada.Text_IO; procedure Ghost_Subp_Spec_And_Body (Formal : Integer) is begin Put_Line ("ERROR: Ghost_Subp_Spec_And_Body"); end Ghost_Subp_Spec_And_Body; -- ghost_subp_spec_and_body.ads procedure Ghost_Subp_Spec_And_Body (Formal : Integer) with Ghost; -- living_with_1.adb with Ghost_Gen; procedure Living_With_1 is package Ghost_Inst is new Ghost_Gen (Integer, 1); begin Ghost_Inst.Ghost_Proc (2); end Living_With_1; -- living_with_2.adb with Ghost_Pack_Spec; use Ghost_Pack_Spec; procedure Living_With_2 is Local_Ghost_Obj : constant Integer := Ghost_Obj with Ghost; begin null; end Living_With_2; -- living_with_3.adb with Ghost_Pack_Spec_And_Body; use Ghost_Pack_Spec_And_Body; procedure Living_With_3 is Local_Ghost_Obj : constant Integer := Ghost_Obj with Ghost; begin Ghost_Proc (Local_Ghost_Obj); end Living_With_3; -- living_with_4.adb with Ghost_Subp_Body; procedure Living_With_4 is Local_Ghost_Obj : constant Integer := 1 with Ghost; begin Ghost_Subp_Body (Local_Ghost_Obj); end Living_With_4; -- living_with_5.adb with Ghost_Subp_Spec_And_Body; procedure Living_With_5 is Local_Ghost_Obj : constant Integer := 1 with Ghost; begin Ghost_Subp_Spec_And_Body (Local_Ghost_Obj); end Living_With_5; ---------------------------- -- Compilation and output -- ---------------------------- $ echo "checked Ghost code, withs from living untis" $ gcc -c -gnatec=check.adc ghost_gen.adb $ gcc -c -gnatec=check.adc ghost_pack_spec.ads $ gcc -c -gnatec=check.adc ghost_pack_spec_and_body.adb $ gcc -c -gnatec=check.adc ghost_subp_body.adb $ gcc -c -gnatec=check.adc ghost_subp_spec_and_body.adb $ gcc -c -gnatec=check.adc living_with_1.adb $ gcc -c -gnatec=check.adc living_with_2.adb $ gcc -c -gnatec=check.adc living_with_3.adb $ gcc -c -gnatec=check.adc living_with_4.adb $ gcc -c -gnatec=check.adc living_with_5.adb $ ls *.o *.ali > objects_and_ali.txt $ grep -n "ghost" objects_and_ali.txt | wc -l $ rm -rf *.o *.ali $ echo "ignored Ghost code, withs from living units" $ gcc -c -gnatec=ignore.adc ghost_gen.adb $ gcc -c -gnatec=ignore.adc ghost_pack_spec.ads $ gcc -c -gnatec=ignore.adc ghost_pack_spec_and_body.adb $ gcc -c -gnatec=ignore.adc ghost_subp_body.adb $ gcc -c -gnatec=ignore.adc ghost_subp_spec_and_body.adb $ gcc -c -gnatec=ignore.adc living_with_1.adb $ gcc -c -gnatec=ignore.adc living_with_2.adb $ gcc -c -gnatec=ignore.adc living_with_3.adb $ gcc -c -gnatec=ignore.adc living_with_4.adb $ gcc -c -gnatec=ignore.adc living_with_5.adb $ ls *.o *.ali > objects_and_ali.txt $ grep "ghost" objects_and_ali.txt | wc -l $ rm -rf *.o *.ali $ gnatmake -f -q -gnatec=ignore.adc living_with_1.adb $ gnatmake -f -q -gnatec=ignore.adc living_with_2.adb $ gnatmake -f -q -gnatec=ignore.adc living_with_3.adb $ gnatmake -f -q -gnatec=ignore.adc living_with_4.adb $ gnatmake -f -q -gnatec=ignore.adc living_with_5.adb $ ./living_with_1 $ ./living_with_2 $ ./living_with_3 $ ./living_with_4 $ ./living_with_5 checked Ghost code, withs from living untis 10 ignored Ghost code, withs from living units 0 Tested on x86_64-pc-linux-gnu, committed on trunk 2016-07-06 Hristian Kirtchev <kirtc...@adacore.com> * gnat1drv.adb: Code clean up. Do not emit any code generation errors when the unit is ignored Ghost.
Index: gnat1drv.adb =================================================================== --- gnat1drv.adb (revision 238040) +++ gnat1drv.adb (working copy) @@ -89,15 +89,6 @@ -------------- procedure Gnat1drv is - Main_Unit_Node : Node_Id; - -- Compilation unit node for main unit - - Main_Kind : Node_Kind; - -- Kind of main compilation unit node - - Back_End_Mode : Back_End.Back_End_Mode_Type; - -- Record back-end mode - procedure Adjust_Global_Switches; -- There are various interactions between front-end switch settings, -- including debug switch settings and target dependent parameters. @@ -105,8 +96,9 @@ -- We do it after scanning out all the switches, so that we are not -- depending on the order in which switches appear. - procedure Check_Bad_Body; - -- Called to check if the unit we are compiling has a bad body + procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind); + -- Called to check whether a unit described by its compilation unit node + -- and kind has a bad body. procedure Check_Rep_Info; -- Called when we are not generating code, to check if -gnatR was requested @@ -712,10 +704,8 @@ -- Check_Bad_Body -- -------------------- - procedure Check_Bad_Body is - Sname : Unit_Name_Type; - Src_Ind : Source_File_Index; - Fname : File_Name_Type; + procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind) is + Fname : File_Name_Type; procedure Bad_Body_Error (Msg : String); -- Issue message for bad body found @@ -726,11 +716,16 @@ procedure Bad_Body_Error (Msg : String) is begin - Error_Msg_N (Msg, Main_Unit_Node); + Error_Msg_N (Msg, Unit_Node); Error_Msg_File_1 := Fname; - Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node); + Error_Msg_N ("remove incorrect body in file{!", Unit_Node); end Bad_Body_Error; + -- Local variables + + Sname : Unit_Name_Type; + Src_Ind : Source_File_Index; + -- Start of processing for Check_Bad_Body begin @@ -743,13 +738,13 @@ -- Check for body not allowed - if (Main_Kind = N_Package_Declaration - and then not Body_Required (Main_Unit_Node)) - or else (Main_Kind = N_Generic_Package_Declaration - and then not Body_Required (Main_Unit_Node)) - or else Main_Kind = N_Package_Renaming_Declaration - or else Main_Kind = N_Subprogram_Renaming_Declaration - or else Nkind (Original_Node (Unit (Main_Unit_Node))) + if (Unit_Kind = N_Package_Declaration + and then not Body_Required (Unit_Node)) + or else (Unit_Kind = N_Generic_Package_Declaration + and then not Body_Required (Unit_Node)) + or else Unit_Kind = N_Package_Renaming_Declaration + or else Unit_Kind = N_Subprogram_Renaming_Declaration + or else Nkind (Original_Node (Unit (Unit_Node))) in N_Generic_Instantiation then Sname := Unit_Name (Main_Unit); @@ -793,16 +788,16 @@ -- be incorrect (we may have misinterpreted a junk spec as not -- needing a body when it really does). - if Main_Kind = N_Package_Declaration + if Unit_Kind = N_Package_Declaration and then Ada_Version = Ada_83 and then Operating_Mode = Generate_Code and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body and then not Compilation_Errors then Error_Msg_N - ("package $$ does not require a body??", Main_Unit_Node); + ("package $$ does not require a body??", Unit_Node); Error_Msg_File_1 := Fname; - Error_Msg_N ("body in file{ will be ignored??", Main_Unit_Node); + Error_Msg_N ("body in file{ will be ignored??", Unit_Node); -- Ada 95 cases of a body file present when no body is -- permitted. This we consider to be an error. @@ -810,15 +805,15 @@ else -- For generic instantiations, we never allow a body - if Nkind (Original_Node (Unit (Main_Unit_Node))) in + if Nkind (Original_Node (Unit (Unit_Node))) in N_Generic_Instantiation then Bad_Body_Error ("generic instantiation for $$ does not allow a body"); - -- A library unit that is a renaming never allows a body + -- A library unit that is a renaming never allows a body - elsif Main_Kind in N_Renaming_Declaration then + elsif Unit_Kind in N_Renaming_Declaration then Bad_Body_Error ("renaming declaration for $$ does not allow a body!"); @@ -829,11 +824,11 @@ -- body when in fact it does. elsif not Compilation_Errors then - if Main_Kind = N_Package_Declaration then + if Unit_Kind = N_Package_Declaration then Bad_Body_Error ("package $$ does not allow a body!"); - elsif Main_Kind = N_Generic_Package_Declaration then + elsif Unit_Kind = N_Generic_Package_Declaration then Bad_Body_Error ("generic package $$ does not allow a body!"); end if; @@ -893,9 +888,18 @@ if AAMP_On_Target then Sem_Ch13.Validate_Independence; end if; - end Post_Compilation_Validation_Checks; + -- Local variables + + Back_End_Mode : Back_End.Back_End_Mode_Type; + + Main_Unit_Kind : Node_Kind; + -- Kind of main compilation unit node + + Main_Unit_Node : Node_Id; + -- Compilation unit node for main unit + -- Start of processing for Gnat1drv begin @@ -1065,9 +1069,10 @@ end if; Main_Unit_Node := Cunit (Main_Unit); - Main_Kind := Nkind (Unit (Main_Unit_Node)); - Check_Bad_Body; + Main_Unit_Kind := Nkind (Unit (Main_Unit_Node)); + Check_Bad_Body (Main_Unit_Node, Main_Unit_Kind); + -- In CodePeer mode we always delete old SCIL files before regenerating -- new ones, in case of e.g. errors, and also to remove obsolete scilx -- files generated by CodePeer itself. @@ -1159,21 +1164,23 @@ -- subunits. Note that we always generate code for all generic units (a -- change from some previous versions of GNAT). - elsif Main_Kind = N_Subprogram_Body and then not Subunits_Missing then + elsif Main_Unit_Kind = N_Subprogram_Body + and then not Subunits_Missing + then Back_End_Mode := Generate_Object; -- We can generate code for a package body unless there are subunits -- missing (note that we always generate code for generic units, which -- is a change from some earlier versions of GNAT). - elsif Main_Kind = N_Package_Body and then not Subunits_Missing then + elsif Main_Unit_Kind = N_Package_Body and then not Subunits_Missing then Back_End_Mode := Generate_Object; -- We can generate code for a package declaration or a subprogram -- declaration only if it does not required a body. - elsif Nkind_In (Main_Kind, N_Package_Declaration, - N_Subprogram_Declaration) + elsif Nkind_In (Main_Unit_Kind, N_Package_Declaration, + N_Subprogram_Declaration) and then (not Body_Required (Main_Unit_Node) or else Distribution_Stub_Mode = Generate_Caller_Stub_Body) @@ -1183,8 +1190,8 @@ -- We can generate code for a generic package declaration of a generic -- subprogram declaration only if does not require a body. - elsif Nkind_In (Main_Kind, N_Generic_Package_Declaration, - N_Generic_Subprogram_Declaration) + elsif Nkind_In (Main_Unit_Kind, N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration) and then not Body_Required (Main_Unit_Node) then Back_End_Mode := Generate_Object; @@ -1192,15 +1199,15 @@ -- Compilation units that are renamings do not require bodies, so we can -- generate code for them. - elsif Nkind_In (Main_Kind, N_Package_Renaming_Declaration, - N_Subprogram_Renaming_Declaration) + elsif Nkind_In (Main_Unit_Kind, N_Package_Renaming_Declaration, + N_Subprogram_Renaming_Declaration) then Back_End_Mode := Generate_Object; -- Compilation units that are generic renamings do not require bodies -- so we can generate code for them. - elsif Main_Kind in N_Generic_Renaming_Declaration then + elsif Main_Unit_Kind in N_Generic_Renaming_Declaration then Back_End_Mode := Generate_Object; -- It is not an error to analyze in CodePeer mode a spec which requires @@ -1240,45 +1247,61 @@ -- generate code). if Back_End_Mode = Skip then - Set_Standard_Error; - Write_Str ("cannot generate code for file "); - Write_Name (Unit_File_Name (Main_Unit)); - if Subunits_Missing then - Write_Str (" (missing subunits)"); - Write_Eol; + -- An ignored Ghost unit is rewritten into a null statement because + -- it must not produce an ALI or object file. Do not emit any errors + -- related to code generation because the unit does not exist. - -- Force generation of ALI file, for backward compatibility + if Main_Unit_Kind = N_Null_Statement + and then Is_Ignored_Ghost_Node + (Original_Node (Unit (Main_Unit_Node))) + then + null; - Opt.Force_ALI_Tree_File := True; + -- Otherwise the unit is missing a crucial piece that prevents code + -- generation. - elsif Main_Kind = N_Subunit then - Write_Str (" (subunit)"); - Write_Eol; + else + Set_Standard_Error; + Write_Str ("cannot generate code for file "); + Write_Name (Unit_File_Name (Main_Unit)); - -- Force generation of ALI file, for backward compatibility + if Subunits_Missing then + Write_Str (" (missing subunits)"); + Write_Eol; - Opt.Force_ALI_Tree_File := True; + -- Force generation of ALI file, for backward compatibility - elsif Main_Kind = N_Subprogram_Declaration then - Write_Str (" (subprogram spec)"); - Write_Eol; + Opt.Force_ALI_Tree_File := True; - -- Generic package body in GNAT implementation mode + elsif Main_Unit_Kind = N_Subunit then + Write_Str (" (subunit)"); + Write_Eol; - elsif Main_Kind = N_Package_Body and then GNAT_Mode then - Write_Str (" (predefined generic)"); - Write_Eol; + -- Force generation of ALI file, for backward compatibility - -- Force generation of ALI file, for backward compatibility + Opt.Force_ALI_Tree_File := True; - Opt.Force_ALI_Tree_File := True; + elsif Main_Unit_Kind = N_Subprogram_Declaration then + Write_Str (" (subprogram spec)"); + Write_Eol; - -- Only other case is a package spec + -- Generic package body in GNAT implementation mode - else - Write_Str (" (package spec)"); - Write_Eol; + elsif Main_Unit_Kind = N_Package_Body and then GNAT_Mode then + Write_Str (" (predefined generic)"); + Write_Eol; + + -- Force generation of ALI file, for backward compatibility + + Opt.Force_ALI_Tree_File := True; + + -- Only other case is a package spec + + else + Write_Str (" (package spec)"); + Write_Eol; + end if; end if; Set_Standard_Output; @@ -1320,7 +1343,7 @@ if Back_End_Mode = Declarations_Only and then (not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode) - or else Main_Kind = N_Subunit + or else Main_Unit_Kind = N_Subunit or else Frontend_Layout_On_Target or else ASIS_GNSA_Mode) then @@ -1465,11 +1488,10 @@ when Program_Error => Comperr.Compiler_Abort ("Program_Error"); + -- Assume this is a bug. If it is real, the message will in any case + -- say Storage_Error, giving a strong hint. + when Storage_Error => - - -- Assume this is a bug. If it is real, the message will in any case - -- say Storage_Error, giving a strong hint. - Comperr.Compiler_Abort ("Storage_Error"); when Unrecoverable_Error => @@ -1482,7 +1504,7 @@ <<End_Of_Program>> null; - -- The outer exception handles an unrecoverable error +-- The outer exception handler handles an unrecoverable error exception when Unrecoverable_Error =>