------------------------------------------------------------------------------ -- -- -- GNATPP COMPONENTS -- -- -- -- A S I S _ U L . S O U R C E _ T A B L E . P R O C E S S I N G . -- -- A S I S _ P R O C E S S I N G -- -- -- -- (adapted for gnatpp from ASIS Utility Library) -- -- -- -- B o d y -- -- -- -- Copyright (C) 2009-2017, AdaCore -- -- -- -- GNATPP is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNATPP is distributed in the hope that it will be useful, but -- -- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABI- -- -- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- -- License for more details. You should have received a copy of the GNU -- -- General Public License distributed with GNAT; see file COPYING. If not, -- -- write to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- -- Boston, -- -- -- -- GNATPP is maintained by AdaCore (http://www.adacore.com) -- -- -- ------------------------------------------------------------------------------ pragma Ada_2012; with Ada.Directories; use Ada.Directories; with Ada.Exceptions; with Ada.Finalization; with Ada.Text_IO; use Ada; with Ada_Trees.PP; with Ada.Wide_Text_IO; with System.WCh_Con; with Opt; with GNATPP.Output; use GNATPP; with GNATPP.Options; use GNATPP.Options; separate (ASIS_UL.Source_Table.Processing) procedure ASIS_Processing (CU : Asis.Compilation_Unit; SF : SF_Id) is -- See also comments on File_Name_File_Name in GNATPP.Options. pragma Assert (not Incremental_Mode); -- We initially write the output to Temp_Output_Name, then later rename it -- to Output_Name (except in Pipe mode). These are full pathnames. If we -- are overwriting the Source_Name, and it's a link link-->file, we want to -- overwrite file. But we put the temp file in the directory containing -- link, in case the directory containing file is not writable. function Get_Output_Name (Resolve_Links : Boolean) return String is (case Output_Mode is when Pipe => "", -- not used when Create_Modes => Res_File_Name.all, when Replace_Modes => Normalize_Pathname (Source_Name (SF), Resolve_Links => Resolve_Links, Case_Sensitive => True), when Default => Source_Name (SF) & PP_Suffix, when Out_Directory => Compose (Out_Dir.all, Short_Source_Name (SF))); Output_Name : constant String := Get_Output_Name (Resolve_Links => True); Temp_Output_Name : constant String := (if Output_Mode = Pipe then "" -- means standard output else Get_Output_Name (Resolve_Links => False) & "__GNATPP-TEMP"); Output_Written : Boolean; -- True if Tree_To_Ada wrote the output to Temp_Output_Name. It always -- does, except in Replace_Modes if the output would be identical to the -- input. procedure Write_File_Name_File; -- If the Output_Mode /= Pipe, and Output_Written is True, add a pair of -- lines to the file name file. procedure Set_Output_Encoding; -- Set the output encoding method. Default is as for the input. procedure Write_File_Name_File is use Text_IO; Lock_File_Name : constant String := File_Name_File_Name.all & ".lock"; procedure Do_Writes; -- Write the two file names to the file name file. This is split out -- into a procedure so we can call it with and without file locking, as -- appropriate. procedure Do_Writes is File_Name_File : File_Type; begin Open (File_Name_File, Mode => Append_File, Name => File_Name_File_Name.all); Put_Line (File_Name_File, Temp_Output_Name); Put_Line (File_Name_File, Output_Name); Close (File_Name_File); end Do_Writes; -- Start of processing for Write_File_Name_File begin if Output_Mode /= Pipe then -- In -r, -rf, and -rnb modes, if the output was identical to the -- input, Output_Written will be False, so there is no -- Temp_Output_Name file, so we don't move it in that case. This can -- also happen if the exception handler at the end of Tree_To_Ada is -- executed. pragma Assert (if Output_Mode not in Replace_Modes then Output_Written); if not Output_Written then return; end if; if Mimic_gcc and then (Verbose_Mode or else Debug_Flag_V) then Put_Line ((if Output_Mode in Replace_Modes then "updating " else "creating ") & (if Debug_Flag_V then Short_Source_Name (SF) else Output_Name)); end if; -- The temp file was created, so write a pair (Temp_Output_Name, -- Output_Name) of lines to the file name file, so Finalize will know -- to rename temp --> output. This is done under lock, in case this -- is an inner process of an incremental build, and the -j switch of -- the builder is used to invoke this in parallel. if Outer_Parallel then pragma Assert (Mimic_gcc); Lock_File (Lock_File_Name); declare -- We create a dummy object whose finalization calls -- Unlock_File, so we don't leave stale lock files around even -- in case of unhandled exceptions. type Dummy_Type is new Ada.Finalization.Limited_Controlled with null record; procedure Finalize (Ignore : in out Dummy_Type); procedure Finalize (Ignore : in out Dummy_Type) is begin Unlock_File (Lock_File_Name); end Finalize; Dummy : Dummy_Type; begin Do_Writes; end; -- Otherwise, it's safe to do the writes without any locking. We want -- to avoid locking when possible, because it reduces the likelihood -- of stale locks left lying around. It's a little more efficient, -- too. else Do_Writes; end if; end if; exception when Lock_Error => ASIS_UL.Output.Error ("cannot create " & Lock_File_Name); ASIS_UL.Output.Error ("delete it by hand if stale"); raise; end Write_File_Name_File; procedure Set_Output_Encoding is use System.WCh_Con; begin -- If the output encoding was not specified on the command line, make it -- the same as the input encoding, which is in -- Opt.Wide_Character_Encoding_Method. See also Check_Parameters. -- Otherwise, it is an error if they are not the same, which happens if -- the user specified both "-gnatWx" and "Wy", where x /= y. if Output_Encoding = WCEM_Default then Output_Encoding := Opt.Wide_Character_Encoding_Method; elsif Output_Encoding /= Opt.Wide_Character_Encoding_Method then ASIS_UL.Output.Error ("input and output wide character encodings conflict"); raise Fatal_Error; end if; The_Formatting_Options.Output_Encoding := Output_Encoding; GNATPP.Output.Set_Form_String; -- This is the second time we're calling Set_Form_String; the first time -- was too early, before we had a correct value for -- Opt.Wide_Character_Encoding_Method. ???Could be cleaned up. -- Also, do we really need two different types for encodings? end Set_Output_Encoding; use Wide_Text_IO; begin case Output_Mode is when Pipe | Replace_Modes | Default => pragma Assert (Res_File_Name = null); pragma Assert (Out_Dir = null); when Create_Modes => pragma Assert (Res_File_Name /= null); pragma Assert (Out_Dir = null); when Out_Directory => pragma Assert (Res_File_Name = null); pragma Assert (Out_Dir /= null); if Out_Dir.all = Containing_Directory (Source_Name (SF)) then Error ("--output-dir=" & Out_Dir.all); Error (" contains input file " & Short_Source_Name (SF)); Error (" skipping " & Short_Source_Name (SF)); Error (" use -rnb to update source files in place"); return; end if; end case; Set_Output_Encoding; if Output_Mode = Replace and then Is_Regular_File (Source_Name (SF) & NPP_Suffix) then Put (Standard_Error, "gnatpp: file "); Put (Standard_Error, To_Wide_String (Source_Name (SF) & NPP_Suffix)); Put (Standard_Error, " exists. Use '-rf' option to override"); New_Line (Standard_Error); return; end if; if Output_Mode in Replace | Force_Replace then if Verbose_Mode then Put (Standard_Error, "gnatpp: creating the back-up copy "); Put (Standard_Error, "of the original source "); Put (Standard_Error, To_Wide_String (Source_Name (SF))); New_Line (Standard_Error); end if; declare Success : Boolean; begin Copy_File (Name => Source_Name (SF), Pathname => Source_Name (SF) & NPP_Suffix, Success => Success, Mode => Overwrite); if not Success then Put (Standard_Error, "gnatpp: can not create "); Put (Standard_Error, "the back-up copy for "); Put (Standard_Error, To_Wide_String (Source_Name (SF))); New_Line (Standard_Error); end if; end; end if; begin Ada_Trees.PP.Asis_To_Ada (CU, Short_Source_Name (SF), The_Formatting_Options, Output_Name => Temp_Output_Name, Form_String => Form_String.all, Do_Diff => Output_Mode in Replace_Modes, Output_Written => Output_Written); Set_Source_Status (SF, Processed); Write_File_Name_File; exception when others => Set_Source_Status (SF, Error_Detected); raise; end; end ASIS_Processing;