diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/fname-sf.adb')
| -rw-r--r-- | gcc-4.8/gcc/ada/fname-sf.adb | 139 |
1 files changed, 0 insertions, 139 deletions
diff --git a/gcc-4.8/gcc/ada/fname-sf.adb b/gcc-4.8/gcc/ada/fname-sf.adb deleted file mode 100644 index f967c1658..000000000 --- a/gcc-4.8/gcc/ada/fname-sf.adb +++ /dev/null @@ -1,139 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- F N A M E . S F -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2008, 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 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 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. -- --- -- ------------------------------------------------------------------------------- - -with Casing; use Casing; -with Fname; use Fname; -with Fname.UF; use Fname.UF; -with SFN_Scan; use SFN_Scan; -with Osint; use Osint; -with Types; use Types; - -with Unchecked_Conversion; - -package body Fname.SF is - - function To_Big_String_Ptr is new Unchecked_Conversion - (Source_Buffer_Ptr, Big_String_Ptr); - - ---------------------- - -- Local Procedures -- - ---------------------- - - procedure Set_File_Name - (Typ : Character; - U : String; - F : String; - Index : Natural); - -- This is a transfer function that is called from Scan_SFN_Pragmas, - -- and reformats its parameters appropriately for the version of - -- Set_File_Name found in Fname.SF. - - procedure Set_File_Name_Pattern - (Pat : String; - Typ : Character; - Dot : String; - Cas : Character); - -- This is a transfer function that is called from Scan_SFN_Pragmas, - -- and reformats its parameters appropriately for the version of - -- Set_File_Name_Pattern found in Fname.SF. - - ----------------------------------- - -- Read_Source_File_Name_Pragmas -- - ----------------------------------- - - procedure Read_Source_File_Name_Pragmas is - Src : Source_Buffer_Ptr; - Hi : Source_Ptr; - BS : Big_String_Ptr; - SP : String_Ptr; - - begin - Name_Buffer (1 .. 8) := "gnat.adc"; - Name_Len := 8; - Read_Source_File (Name_Enter, 0, Hi, Src); - - if Src /= null then - BS := To_Big_String_Ptr (Src); - SP := BS (1 .. Natural (Hi))'Unrestricted_Access; - Scan_SFN_Pragmas - (SP.all, - Set_File_Name'Access, - Set_File_Name_Pattern'Access); - end if; - end Read_Source_File_Name_Pragmas; - - ------------------- - -- Set_File_Name -- - ------------------- - - procedure Set_File_Name - (Typ : Character; - U : String; - F : String; - Index : Natural) - is - Unm : Unit_Name_Type; - Fnm : File_Name_Type; - begin - Name_Buffer (1 .. U'Length) := U; - Name_Len := U'Length; - Set_Casing (All_Lower_Case); - Name_Buffer (Name_Len + 1) := '%'; - Name_Buffer (Name_Len + 2) := Typ; - Name_Len := Name_Len + 2; - Unm := Name_Find; - Name_Buffer (1 .. F'Length) := F; - Name_Len := F'Length; - Fnm := Name_Find; - Fname.UF.Set_File_Name (Unm, Fnm, Nat (Index)); - end Set_File_Name; - - --------------------------- - -- Set_File_Name_Pattern -- - --------------------------- - - procedure Set_File_Name_Pattern - (Pat : String; - Typ : Character; - Dot : String; - Cas : Character) - is - Ctyp : Casing_Type; - Patp : constant String_Ptr := new String'(Pat); - Dotp : constant String_Ptr := new String'(Dot); - - begin - if Cas = 'l' then - Ctyp := All_Lower_Case; - elsif Cas = 'u' then - Ctyp := All_Upper_Case; - else -- Cas = 'm' - Ctyp := Mixed_Case; - end if; - - Fname.UF.Set_File_Name_Pattern (Patp, Typ, Dotp, Ctyp); - end Set_File_Name_Pattern; - -end Fname.SF; |