gcc/ada/mlib-fil.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             M L I B . F I L                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2001-2007, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This package provides a set of routines to deal with file extensions
  27
  28 with Ada.Strings.Fixed;
  29 with MLib.Tgt;
  30
  31 package body MLib.Fil is
  32
  33    use Ada;
  34
  35    package Target renames MLib.Tgt;
  36
  37    ---------------
  38    -- Append_To --
  39    ---------------
  40
  41    function Append_To
  42      (Filename : String;
  43       Ext      : String) return String
  44    is
  45    begin
  46       if Ext'Length = 0 then
  47          return Filename;
  48
  49       elsif Filename (Filename'Last) = '.' then
  50          if Ext (Ext'First) = '.' then
  51             return Filename & Ext (Ext'First + 1 .. Ext'Last);
  52
  53          else
  54             return Filename & Ext;
  55          end if;
  56
  57       else
  58          if Ext (Ext'First) = '.' then
  59             return Filename & Ext;
  60
  61          else
  62             return Filename & '.' & Ext;
  63          end if;
  64       end if;
  65    end Append_To;
  66
  67    ------------
  68    -- Ext_To --
  69    ------------
  70
  71    function Ext_To
  72      (Filename : String;
  73       New_Ext  : String := "") return String
  74    is
  75       use Strings.Fixed;
  76
  77       J : constant Natural :=
  78             Index (Source  =>  Filename,
  79                    Pattern => ".",
  80                    Going   => Strings.Backward);
  81
  82    begin
  83       if J = 0 then
  84          if New_Ext = "" then
  85             return Filename;
  86          else
  87             return Filename & "." & New_Ext;
  88          end if;
  89
  90       else
  91          if New_Ext = "" then
  92             return Head (Filename, J - 1);
  93          else
  94             return Head (Filename, J - 1) & '.' & New_Ext;
  95          end if;
  96       end if;
  97    end Ext_To;
  98
  99    -------------
 100    -- Get_Ext --
 101    -------------
 102
 103    function Get_Ext (Filename : String) return String is
 104       use Strings.Fixed;
 105
 106       J : constant Natural :=
 107             Index (Source  =>  Filename,
 108                    Pattern => ".",
 109                    Going   => Strings.Backward);
 110
 111    begin
 112       if J = 0 then
 113          return "";
 114       else
 115          return Filename (J .. Filename'Last);
 116       end if;
 117    end Get_Ext;
 118
 119    ----------------
 120    -- Is_Archive --
 121    ----------------
 122
 123    function Is_Archive (Filename : String) return Boolean is
 124       Ext : constant String := Get_Ext (Filename);
 125    begin
 126       return Target.Is_Archive_Ext (Ext);
 127    end Is_Archive;
 128
 129    ----------
 130    -- Is_C --
 131    ----------
 132
 133    function Is_C (Filename : String) return Boolean is
 134       Ext : constant String := Get_Ext (Filename);
 135    begin
 136       return Target.Is_C_Ext (Ext);
 137    end Is_C;
 138
 139    ------------
 140    -- Is_Obj --
 141    ------------
 142
 143    function Is_Obj (Filename : String) return Boolean is
 144       Ext : constant String := Get_Ext (Filename);
 145    begin
 146       return Target.Is_Object_Ext (Ext);
 147    end Is_Obj;
 148
 149 end MLib.Fil;