X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fosint-c.adb;h=8b67befc6c69fc2012677cf6f1b3e4fc8edca5f9;hb=17052c8f8f63239deccec6d06ff1d9a9ebfc4640;hp=a8b02690185923fb8eb5d65e97d0b2281707b705;hpb=314a23b6eb1ed66ddce188a8e105c8050b99b87e;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index a8b02690185..8b67befc6c6 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- 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, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -25,34 +24,33 @@ ------------------------------------------------------------------------------ with Hostparm; -with Namet; use Namet; with Opt; use Opt; with Tree_IO; use Tree_IO; package body Osint.C is Output_Object_File_Name : String_Ptr; - -- Argument of -o compiler option, if given. This is needed to - -- verify consistency with the ALI file name. + -- Argument of -o compiler option, if given. This is needed to verify + -- consistency with the ALI file name. procedure Adjust_OS_Resource_Limits; pragma Import (C, Adjust_OS_Resource_Limits, "__gnat_adjust_os_resource_limits"); - -- Procedure to make system specific adjustments to make GNAT - -- run better. + -- Procedure to make system specific adjustments to make GNAT run better function Create_Auxiliary_File (Src : File_Name_Type; Suffix : String) return File_Name_Type; - -- Common processing for Creat_Repinfo_File and Create_Debug_File. - -- Src is the file name used to create the required output file and - -- Suffix is the desired suffic (dg/rep for debug/repinfo file). + -- Common processing for Create_List_File, Create_Repinfo_File and + -- Create_Debug_File. Src is the file name used to create the required + -- output file and Suffix is the desired suffix (dg/rep/xxx for debug/ + -- repinfo/list file where xxx is specified extension. procedure Set_Library_Info_Name; - -- Sets a default ali file name from the main compiler source name. + -- Sets a default ALI file name from the main compiler source name. -- This is used by Create_Output_Library_Info, and by the version of -- Read_Library_Info that takes a default file name. The name is in - -- Name_Buffer (with length in Name_Len) on return from the call + -- Name_Buffer (with length in Name_Len) on return from the call. ---------------------- -- Close_Debug_File -- @@ -66,11 +64,28 @@ package body Osint.C is if not Status then Fail - ("error while closing expanded source file ", - Get_Name_String (Output_File_Name)); + ("error while closing expanded source file " + & Get_Name_String (Output_File_Name)); end if; end Close_Debug_File; + --------------------- + -- Close_List_File -- + --------------------- + + procedure Close_List_File is + Status : Boolean; + + begin + Close (Output_FD, Status); + + if not Status then + Fail + ("error while closing list file " + & Get_Name_String (Output_File_Name)); + end if; + end Close_List_File; + ------------------------------- -- Close_Output_Library_Info -- ------------------------------- @@ -83,8 +98,8 @@ package body Osint.C is if not Status then Fail - ("error while closing ALI file ", - Get_Name_String (Output_File_Name)); + ("error while closing ALI file " + & Get_Name_String (Output_File_Name)); end if; end Close_Output_Library_Info; @@ -100,8 +115,8 @@ package body Osint.C is if not Status then Fail - ("error while closing representation info file ", - Get_Name_String (Output_File_Name)); + ("error while closing representation info file " + & Get_Name_String (Output_File_Name)); end if; end Close_Repinfo_File; @@ -111,7 +126,7 @@ package body Osint.C is function Create_Auxiliary_File (Src : File_Name_Type; - Suffix : String) return File_Name_Type + Suffix : String) return File_Name_Type is Result : File_Name_Type; @@ -129,13 +144,10 @@ package body Osint.C is Name_Len := Name_Len + Suffix'Length; if Output_Object_File_Name /= null then - for Index in reverse Output_Object_File_Name'Range loop - if Output_Object_File_Name (Index) = Directory_Separator then declare File_Name : constant String := Name_Buffer (1 .. Name_Len); - begin Name_Len := Index - Output_Object_File_Name'First + 1; Name_Buffer (1 .. Name_Len) := @@ -166,27 +178,52 @@ package body Osint.C is return Create_Auxiliary_File (Src, "dg"); end Create_Debug_File; + ---------------------- + -- Create_List_File -- + ---------------------- + + procedure Create_List_File (S : String) is + F : File_Name_Type; + pragma Warnings (Off, F); + begin + if S (S'First) = '.' then + F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last)); + + else + Name_Buffer (1 .. S'Length) := S; + Name_Len := S'Length + 1; + Name_Buffer (Name_Len) := ASCII.NUL; + Create_File_And_Check (Output_FD, Text); + end if; + end Create_List_File; + -------------------------------- -- Create_Output_Library_Info -- -------------------------------- procedure Create_Output_Library_Info is + Dummy : Boolean; + pragma Unreferenced (Dummy); + begin Set_Library_Info_Name; + Delete_File (Name_Buffer (1 .. Name_Len), Dummy); Create_File_And_Check (Output_FD, Text); end Create_Output_Library_Info; - -------------------------- - -- Creat_Repinfo_File -- - -------------------------- - - procedure Creat_Repinfo_File (Src : File_Name_Type) is - S : constant File_Name_Type := Create_Auxiliary_File (Src, "rep"); - pragma Warnings (Off, S); + ------------------------- + -- Create_Repinfo_File -- + ------------------------- + procedure Create_Repinfo_File (Src : String) is + Discard : File_Name_Type; + pragma Warnings (Off, Discard); begin + Name_Buffer (1 .. Src'Length) := Src; + Name_Len := Src'Length; + Discard := Create_Auxiliary_File (Name_Find, "rep"); return; - end Creat_Repinfo_File; + end Create_Repinfo_File; --------------------------- -- Debug_File_Eol_Length -- @@ -203,6 +240,17 @@ package body Osint.C is end if; end Debug_File_Eol_Length; + --------------------------------- + -- Get_Output_Object_File_Name -- + --------------------------------- + + function Get_Output_Object_File_Name return String is + begin + pragma Assert (Output_Object_File_Name /= null); + + return Output_Object_File_Name.all; + end Get_Output_Object_File_Name; + ----------------------- -- More_Source_Files -- ----------------------- @@ -282,14 +330,21 @@ package body Osint.C is -- Remove extension preparing to replace it declare - Name : constant String := Name_Buffer (1 .. Dot_Index); - Len : constant Natural := Dot_Index; + Name : String := Name_Buffer (1 .. Dot_Index); + First : Positive; begin Name_Buffer (1 .. Output_Object_File_Name'Length) := Output_Object_File_Name.all; - Dot_Index := 0; + -- Put two names in canonical case, to allow object file names + -- with upper-case letters on Windows. + + Canonical_Case_File_Name (Name); + Canonical_Case_File_Name + (Name_Buffer (1 .. Output_Object_File_Name'Length)); + + Dot_Index := 0; for J in reverse Output_Object_File_Name'Range loop if Name_Buffer (J) = '.' then Dot_Index := J; @@ -297,13 +352,24 @@ package body Osint.C is end if; end loop; - -- Dot_Index should be zero now (we check for extension elsewhere) + -- Dot_Index should not be zero now (we check for extension + -- elsewhere). pragma Assert (Dot_Index /= 0); + -- Look for first character of file name + + First := Dot_Index; + while First > 1 + and then Name_Buffer (First - 1) /= Directory_Separator + and then Name_Buffer (First - 1) /= '/' + loop + First := First - 1; + end loop; + -- Check name of object file is what we expect - if Name /= Name_Buffer (Dot_Index - Len + 1 .. Dot_Index) then + if Name /= Name_Buffer (First .. Dot_Index) then Fail ("incorrect object file name"); end if; end; @@ -320,12 +386,12 @@ package body Osint.C is --------------------------------- procedure Set_Output_Object_File_Name (Name : String) is - Ext : constant String := Object_Suffix; + Ext : constant String := Target_Object_Suffix; NL : constant Natural := Name'Length; EL : constant Natural := Ext'Length; begin - -- Make sure that the object file has the expected extension. + -- Make sure that the object file has the expected extension if NL <= EL or else @@ -350,8 +416,8 @@ package body Osint.C is if not Status then Fail - ("error while closing tree file ", - Get_Name_String (Output_File_Name)); + ("error while closing tree file " + & Get_Name_String (Output_File_Name)); end if; end Tree_Close; @@ -388,7 +454,7 @@ package body Osint.C is pragma Assert (Dot_Index /= 0); - -- Change exctension to adt + -- Change extension to adt Name_Buffer (Dot_Index) := '.'; Name_Buffer (Dot_Index + 1) := 'a'; @@ -413,6 +479,15 @@ package body Osint.C is procedure Write_Library_Info (Info : String) renames Write_Info; + --------------------- + -- Write_List_Info -- + --------------------- + + procedure Write_List_Info (S : String) is + begin + Write_With_Check (S'Address, S'Length); + end Write_List_Info; + ------------------------ -- Write_Repinfo_Line -- ------------------------ @@ -420,12 +495,15 @@ package body Osint.C is procedure Write_Repinfo_Line (Info : String) renames Write_Info; begin - Adjust_OS_Resource_Limits; - Opt.Creat_Repinfo_File_Access := Creat_Repinfo_File'Access; - Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access; - Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access; - Set_Program (Compiler); + Opt.Create_Repinfo_File_Access := Create_Repinfo_File'Access; + Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access; + Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access; + Opt.Create_List_File_Access := Create_List_File'Access; + Opt.Write_List_Info_Access := Write_List_Info'Access; + Opt.Close_List_File_Access := Close_List_File'Access; + + Set_Program (Compiler); end Osint.C;