gcc/ada/a-direct.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                      A D A . D I R E C T O R I E S                       --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Ada.Directories.Validity;   use Ada.Directories.Validity;
  35 with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
  36 with Ada.Unchecked_Deallocation;
  37 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  38
  39 with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  40 with GNAT.OS_Lib;                use GNAT.OS_Lib;
  41 with GNAT.Regexp;                use GNAT.Regexp;
  42 --  ??? Ada units should not depend on GNAT units
  43
  44 with System;
  45
  46 package body Ada.Directories is
  47
  48    type Search_Data is record
  49       Is_Valid      : Boolean := False;
  50       Name          : Ada.Strings.Unbounded.Unbounded_String;
  51       Pattern       : Regexp;
  52       Filter        : Filter_Type;
  53       Dir           : Dir_Type;
  54       Entry_Fetched : Boolean := False;
  55       Dir_Entry     : Directory_Entry_Type;
  56    end record;
  57    --  Comment required ???
  58
  59    Empty_String : constant String := (1 .. 0 => ASCII.NUL);
  60    --  Comment required ???
  61
  62    procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
  63
  64    function File_Exists (Name : String) return Boolean;
  65    --  Returns True if the named file exists
  66
  67    procedure Fetch_Next_Entry (Search : Search_Type);
  68    --  Get the next entry in a directory, setting Entry_Fetched if successful
  69    --  or resetting Is_Valid if not.
  70
  71    procedure To_Lower_If_Case_Insensitive (S : in out String);
  72    --  Put S in lower case if file and path names are case-insensitive
  73
  74    ---------------
  75    -- Base_Name --
  76    ---------------
  77
  78    function Base_Name (Name : String) return String is
  79       Simple : String := Simple_Name (Name);
  80       --  Simple'First is guaranteed to be 1
  81
  82    begin
  83       To_Lower_If_Case_Insensitive (Simple);
  84
  85       --  Look for the last dot in the file name and return the part of the
  86       --  file name preceding this last dot. If the first dot is the first
  87       --  character of the file name, the base name is the empty string.
  88
  89       for Pos in reverse Simple'Range loop
  90          if Simple (Pos) = '.' then
  91             return Simple (1 .. Pos - 1);
  92          end if;
  93       end loop;
  94
  95       --  If there is no dot, return the complete file name
  96
  97       return Simple;
  98    end Base_Name;
  99
 100    -------------
 101    -- Compose --
 102    -------------
 103
 104    function Compose
 105      (Containing_Directory : String := "";
 106       Name                 : String;
 107       Extension            : String := "") return String
 108    is
 109       Result : String (1 .. Containing_Directory'Length +
 110                               Name'Length + Extension'Length + 2);
 111       Last   : Natural;
 112
 113    begin
 114       --  First, deal with the invalid cases
 115
 116       if not Is_Valid_Path_Name (Containing_Directory) then
 117          raise Name_Error;
 118
 119       elsif
 120         Extension'Length = 0 and then (not Is_Valid_Simple_Name (Name))
 121       then
 122          raise Name_Error;
 123
 124       elsif Extension'Length /= 0 and then
 125         (not Is_Valid_Simple_Name (Name & '.' & Extension))
 126       then
 127          raise Name_Error;
 128
 129          --  This is not an invalid case so build the path name
 130
 131       else
 132          Last := Containing_Directory'Length;
 133          Result (1 .. Last) := Containing_Directory;
 134
 135          --  Add a directory separator if needed
 136
 137          if Result (Last) /= Dir_Separator then
 138             Last := Last + 1;
 139             Result (Last) := Dir_Separator;
 140          end if;
 141
 142          --  Add the file name
 143
 144          Result (Last + 1 .. Last + Name'Length) := Name;
 145          Last := Last + Name'Length;
 146
 147          --  If extension was specified, add dot followed by this extension
 148
 149          if Extension'Length /= 0 then
 150             Last := Last + 1;
 151             Result (Last) := '.';
 152             Result (Last + 1 .. Last + Extension'Length) := Extension;
 153             Last := Last + Extension'Length;
 154          end if;
 155
 156          To_Lower_If_Case_Insensitive (Result (1 .. Last));
 157          return Result (1 .. Last);
 158       end if;
 159    end Compose;
 160
 161    --------------------------
 162    -- Containing_Directory --
 163    --------------------------
 164
 165    function Containing_Directory (Name : String) return String is
 166    begin
 167       --  First, the invalid case
 168
 169       if not Is_Valid_Path_Name (Name) then
 170          raise Name_Error;
 171
 172       else
 173          --  Get the directory name using GNAT.Directory_Operations.Dir_Name
 174
 175          declare
 176             Value : constant String := Dir_Name (Path => Name);
 177             Result : String (1 .. Value'Length);
 178             Last : Natural := Result'Last;
 179
 180          begin
 181             Result := Value;
 182
 183             --  Remove any trailing directory separator, except as the first
 184             --  character.
 185
 186             while Last > 1 and then Result (Last) = Dir_Separator loop
 187                Last := Last - 1;
 188             end loop;
 189
 190             --  Special case of current directory, identified by "."
 191
 192             if Last = 1 and then Result (1) = '.' then
 193                return Get_Current_Dir;
 194
 195             else
 196                To_Lower_If_Case_Insensitive (Result (1 .. Last));
 197                return Result (1 .. Last);
 198             end if;
 199          end;
 200       end if;
 201    end Containing_Directory;
 202
 203    ---------------
 204    -- Copy_File --
 205    ---------------
 206
 207    procedure Copy_File
 208      (Source_Name   : String;
 209       Target_Name   : String;
 210       Form          : String := "")
 211    is
 212       pragma Unreferenced (Form);
 213       Success : Boolean;
 214
 215    begin
 216       --  First, the invalid cases
 217
 218       if not Is_Valid_Path_Name (Source_Name)
 219         or else not Is_Valid_Path_Name (Target_Name)
 220         or else not Is_Regular_File (Source_Name)
 221       then
 222          raise Name_Error;
 223
 224       elsif Is_Directory (Target_Name) then
 225          raise Use_Error;
 226
 227       else
 228          --  The implementation uses GNAT.OS_Lib.Copy_File, with parameters
 229          --  suitable for all platforms.
 230
 231          Copy_File
 232            (Source_Name, Target_Name, Success, Overwrite, None);
 233
 234          if not Success then
 235             raise Use_Error;
 236          end if;
 237       end if;
 238    end Copy_File;
 239
 240    ----------------------
 241    -- Create_Directory --
 242    ----------------------
 243
 244    procedure Create_Directory
 245      (New_Directory : String;
 246       Form          : String := "")
 247    is
 248       pragma Unreferenced (Form);
 249
 250    begin
 251       --  First, the invalid case
 252
 253       if not Is_Valid_Path_Name (New_Directory) then
 254          raise Name_Error;
 255
 256       else
 257          --  The implementation uses GNAT.Directory_Operations.Make_Dir
 258
 259          begin
 260             Make_Dir (Dir_Name => New_Directory);
 261
 262          exception
 263             when Directory_Error =>
 264                raise Use_Error;
 265          end;
 266       end if;
 267    end Create_Directory;
 268
 269    -----------------
 270    -- Create_Path --
 271    -----------------
 272
 273    procedure Create_Path
 274      (New_Directory : String;
 275       Form          : String := "")
 276    is
 277       pragma Unreferenced (Form);
 278
 279       New_Dir : String (1 .. New_Directory'Length + 1);
 280       Last    : Positive := 1;
 281
 282    begin
 283       --  First, the invalid case
 284
 285       if not Is_Valid_Path_Name (New_Directory) then
 286          raise Name_Error;
 287
 288       else
 289          --  Build New_Dir with a directory separator at the end, so that the
 290          --  complete path will be found in the loop below.
 291
 292          New_Dir (1 .. New_Directory'Length) := New_Directory;
 293          New_Dir (New_Dir'Last) := Directory_Separator;
 294
 295          --  Create, if necessary, each directory in the path
 296
 297          for J in 2 .. New_Dir'Last loop
 298
 299             --  Look for the end of an intermediate directory
 300
 301             if New_Dir (J) /= Dir_Separator then
 302                Last := J;
 303
 304             --  We have found a new intermediate directory each time we find
 305             --  a first directory separator.
 306
 307             elsif New_Dir (J - 1) /= Dir_Separator then
 308
 309                --  No need to create the directory if it already exists
 310
 311                if Is_Directory (New_Dir (1 .. Last)) then
 312                   null;
 313
 314                --  It is an error if a file with such a name already exists
 315
 316                elsif Is_Regular_File (New_Dir (1 .. Last)) then
 317                   raise Use_Error;
 318
 319                else
 320                   --  The implementation uses
 321                   --  GNAT.Directory_Operations.Make_Dir.
 322
 323                   begin
 324                      Make_Dir (Dir_Name => New_Dir (1 .. Last));
 325
 326                   exception
 327                      when Directory_Error =>
 328                         raise Use_Error;
 329                   end;
 330                end if;
 331             end if;
 332          end loop;
 333       end if;
 334    end Create_Path;
 335
 336    -----------------------
 337    -- Current_Directory --
 338    -----------------------
 339
 340    function Current_Directory return String is
 341
 342       --  The implementation uses GNAT.Directory_Operations.Get_Current_Dir
 343
 344       Cur : String := Normalize_Pathname (Get_Current_Dir);
 345
 346    begin
 347       To_Lower_If_Case_Insensitive (Cur);
 348
 349       if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
 350          return Cur (1 .. Cur'Last - 1);
 351       else
 352          return Cur;
 353       end if;
 354    end Current_Directory;
 355
 356    ----------------------
 357    -- Delete_Directory --
 358    ----------------------
 359
 360    procedure Delete_Directory (Directory : String) is
 361    begin
 362       --  First, the invalid cases
 363
 364       if not Is_Valid_Path_Name (Directory) then
 365          raise Name_Error;
 366
 367       elsif not Is_Directory (Directory) then
 368          raise Name_Error;
 369
 370       else
 371          --  The implementation uses GNAT.Directory_Operations.Remove_Dir
 372
 373          begin
 374             Remove_Dir (Dir_Name => Directory, Recursive => False);
 375
 376          exception
 377             when Directory_Error =>
 378                raise Use_Error;
 379          end;
 380       end if;
 381    end Delete_Directory;
 382
 383    -----------------
 384    -- Delete_File --
 385    -----------------
 386
 387    procedure Delete_File (Name : String) is
 388       Success : Boolean;
 389
 390    begin
 391       --  First, the invalid cases
 392
 393       if not Is_Valid_Path_Name (Name) then
 394          raise Name_Error;
 395
 396       elsif not Is_Regular_File (Name) then
 397          raise Name_Error;
 398
 399       else
 400          --  The implementation uses GNAT.OS_Lib.Delete_File
 401
 402          Delete_File (Name, Success);
 403
 404          if not Success then
 405             raise Use_Error;
 406          end if;
 407       end if;
 408    end Delete_File;
 409
 410    -----------------
 411    -- Delete_Tree --
 412    -----------------
 413
 414    procedure Delete_Tree (Directory : String) is
 415    begin
 416       --  First, the invalid cases
 417
 418       if not Is_Valid_Path_Name (Directory) then
 419          raise Name_Error;
 420
 421       elsif not Is_Directory (Directory) then
 422          raise Name_Error;
 423
 424       else
 425          --  The implementation uses GNAT.Directory_Operations.Remove_Dir
 426
 427          begin
 428             Remove_Dir (Directory, Recursive => True);
 429
 430          exception
 431             when Directory_Error =>
 432                raise Use_Error;
 433          end;
 434       end if;
 435    end Delete_Tree;
 436
 437    ------------
 438    -- Exists --
 439    ------------
 440
 441    function Exists (Name : String) return Boolean is
 442    begin
 443       --  First, the invalid case
 444
 445       if not Is_Valid_Path_Name (Name) then
 446          raise Name_Error;
 447
 448       else
 449          --  The implementation is in File_Exists
 450
 451          return File_Exists (Name);
 452       end if;
 453    end Exists;
 454
 455    ---------------
 456    -- Extension --
 457    ---------------
 458
 459    function Extension (Name : String) return String is
 460    begin
 461       --  First, the invalid case
 462
 463       if not Is_Valid_Path_Name (Name) then
 464          raise Name_Error;
 465
 466       else
 467          --  Look for first dot that is not followed by a directory separator
 468
 469          for Pos in reverse Name'Range loop
 470
 471             --  If a directory separator is found before a dot, there
 472             --  is no extension.
 473
 474             if Name (Pos) = Dir_Separator then
 475                return Empty_String;
 476
 477             elsif Name (Pos) = '.' then
 478
 479                --  We found a dot, build the return value with lower bound 1
 480
 481                declare
 482                   Result : String (1 .. Name'Last - Pos);
 483                begin
 484                   Result := Name (Pos + 1 .. Name'Last);
 485                   return Result;
 486                   --  This should be done with a subtype conversion, avoiding
 487                   --  the unnecessary junk copy ???
 488                end;
 489             end if;
 490          end loop;
 491
 492          --  No dot were found, there is no extension
 493
 494          return Empty_String;
 495       end if;
 496    end Extension;
 497
 498    ----------------------
 499    -- Fetch_Next_Entry --
 500    ----------------------
 501
 502    procedure Fetch_Next_Entry (Search : Search_Type) is
 503       Name : String (1 .. 255);
 504       Last : Natural;
 505
 506       Kind : File_Kind := Ordinary_File;
 507       --  Initialized to avoid a compilation warning
 508
 509    begin
 510       --  Search.Value.Is_Valid is always True when Fetch_Next_Entry is called
 511
 512       loop
 513          Read (Search.Value.Dir, Name, Last);
 514
 515          --  If no matching entry is found, set Is_Valid to False
 516
 517          if Last = 0 then
 518             Search.Value.Is_Valid := False;
 519             exit;
 520          end if;
 521
 522          --  Check if the entry matches the pattern
 523
 524          if Match (Name (1 .. Last), Search.Value.Pattern) then
 525             declare
 526                Full_Name : constant String :=
 527                              Compose
 528                                (To_String
 529                                   (Search.Value.Name), Name (1 .. Last));
 530                Found     : Boolean := False;
 531
 532             begin
 533                if File_Exists (Full_Name) then
 534
 535                   --  Now check if the file kind matches the filter
 536
 537                   if Is_Regular_File (Full_Name) then
 538                      if Search.Value.Filter (Ordinary_File) then
 539                         Kind := Ordinary_File;
 540                         Found := True;
 541                      end if;
 542
 543                   elsif Is_Directory (Full_Name) then
 544                      if Search.Value.Filter (Directory) then
 545                         Kind := Directory;
 546                         Found := True;
 547                      end if;
 548
 549                   elsif Search.Value.Filter (Special_File) then
 550                      Kind := Special_File;
 551                      Found := True;
 552                   end if;
 553
 554                   --  If it does, update Search and return
 555
 556                   if Found then
 557                      Search.Value.Entry_Fetched := True;
 558                      Search.Value.Dir_Entry :=
 559                        (Is_Valid => True,
 560                         Simple   => To_Unbounded_String (Name (1 .. Last)),
 561                         Full     => To_Unbounded_String (Full_Name),
 562                         Kind     => Kind);
 563                      exit;
 564                   end if;
 565                end if;
 566             end;
 567          end if;
 568       end loop;
 569    end Fetch_Next_Entry;
 570
 571    -----------------
 572    -- File_Exists --
 573    -----------------
 574
 575    function File_Exists (Name : String) return Boolean is
 576       function C_File_Exists (A : System.Address) return Integer;
 577       pragma Import (C, C_File_Exists, "__gnat_file_exists");
 578
 579       C_Name : String (1 .. Name'Length + 1);
 580
 581    begin
 582       C_Name (1 .. Name'Length) := Name;
 583       C_Name (C_Name'Last) := ASCII.NUL;
 584       return C_File_Exists (C_Name (1)'Address) = 1;
 585    end File_Exists;
 586
 587    --------------
 588    -- Finalize --
 589    --------------
 590
 591    procedure Finalize (Search : in out Search_Type) is
 592    begin
 593       if Search.Value /= null then
 594
 595          --  Close the directory, if one is open
 596
 597          if Is_Open (Search.Value.Dir) then
 598             Close (Search.Value.Dir);
 599          end if;
 600
 601          Free (Search.Value);
 602       end if;
 603    end Finalize;
 604
 605    ---------------
 606    -- Full_Name --
 607    ---------------
 608
 609    function Full_Name (Name : String) return String is
 610    begin
 611       --  First, the invalid case
 612
 613       if not Is_Valid_Path_Name (Name) then
 614          raise Name_Error;
 615
 616       else
 617          --  Build the return value with lower bound 1
 618
 619          --  Use GNAT.OS_Lib.Normalize_Pathname
 620
 621          declare
 622             Value : String := Normalize_Pathname (Name);
 623             subtype Result is String (1 .. Value'Length);
 624          begin
 625             To_Lower_If_Case_Insensitive (Value);
 626             return Result (Value);
 627          end;
 628       end if;
 629    end Full_Name;
 630
 631    function Full_Name (Directory_Entry : Directory_Entry_Type) return String is
 632    begin
 633       --  First, the invalid case
 634
 635       if not Directory_Entry.Is_Valid then
 636          raise Status_Error;
 637
 638       else
 639          --  The value to return has already been computed
 640
 641          return To_String (Directory_Entry.Full);
 642       end if;
 643    end Full_Name;
 644
 645    --------------------
 646    -- Get_Next_Entry --
 647    --------------------
 648
 649    procedure Get_Next_Entry
 650      (Search          : in out Search_Type;
 651       Directory_Entry : out Directory_Entry_Type)
 652    is
 653    begin
 654       --  First, the invalid case
 655
 656       if Search.Value = null or else not Search.Value.Is_Valid then
 657          raise Status_Error;
 658       end if;
 659
 660       --  Fetch the next entry, if needed
 661
 662       if not Search.Value.Entry_Fetched then
 663          Fetch_Next_Entry (Search);
 664       end if;
 665
 666       --  It is an error if no valid entry is found
 667
 668       if not Search.Value.Is_Valid then
 669          raise Status_Error;
 670
 671       else
 672          --  Reset Entry_Fatched and return the entry
 673
 674          Search.Value.Entry_Fetched := False;
 675          Directory_Entry := Search.Value.Dir_Entry;
 676       end if;
 677    end Get_Next_Entry;
 678
 679    ----------
 680    -- Kind --
 681    ----------
 682
 683    function Kind (Name : String) return File_Kind is
 684    begin
 685       --  First, the invalid case
 686
 687       if not File_Exists (Name) then
 688          raise Name_Error;
 689
 690       elsif Is_Regular_File (Name) then
 691          return Ordinary_File;
 692
 693       elsif Is_Directory (Name) then
 694          return Directory;
 695
 696       else
 697          return Special_File;
 698       end if;
 699    end Kind;
 700
 701    function Kind (Directory_Entry : Directory_Entry_Type) return File_Kind is
 702    begin
 703       --  First, the invalid case
 704
 705       if not Directory_Entry.Is_Valid then
 706          raise Status_Error;
 707
 708       else
 709          --  The value to return has already be computed
 710
 711          return Directory_Entry.Kind;
 712       end if;
 713    end Kind;
 714
 715    -----------------------
 716    -- Modification_Time --
 717    -----------------------
 718
 719    function Modification_Time (Name : String) return Ada.Calendar.Time is
 720       Date   : OS_Time;
 721       Year   : Year_Type;
 722       Month  : Month_Type;
 723       Day    : Day_Type;
 724       Hour   : Hour_Type;
 725       Minute : Minute_Type;
 726       Second : Second_Type;
 727
 728    begin
 729       --  First, the invalid cases
 730
 731       if not (Is_Regular_File (Name) or else Is_Directory (Name)) then
 732          raise Name_Error;
 733
 734       else
 735          Date := File_Time_Stamp (Name);
 736          --  ???? We need to be able to convert OS_Time to Ada.Calendar.Time
 737          --  For now, use the component of the OS_Time to create the
 738          --  Calendar.Time value.
 739
 740          GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
 741
 742          return Ada.Calendar.Time_Of
 743            (Year, Month, Day, Duration (Second + 60 * (Minute + 60 * Hour)));
 744       end if;
 745    end Modification_Time;
 746
 747    function Modification_Time
 748      (Directory_Entry : Directory_Entry_Type) return Ada.Calendar.Time
 749    is
 750    begin
 751       --  First, the invalid case
 752
 753       if not Directory_Entry.Is_Valid then
 754          raise Status_Error;
 755
 756       else
 757          --  The value to return has already be computed
 758
 759          return Modification_Time (To_String (Directory_Entry.Full));
 760       end if;
 761    end Modification_Time;
 762
 763    ------------------
 764    -- More_Entries --
 765    ------------------
 766
 767    function More_Entries (Search : Search_Type) return Boolean is
 768    begin
 769       if Search.Value = null then
 770          return False;
 771
 772       elsif Search.Value.Is_Valid then
 773
 774          --  Fetch the next entry, if needed
 775
 776          if not Search.Value.Entry_Fetched then
 777             Fetch_Next_Entry (Search);
 778          end if;
 779       end if;
 780
 781       return Search.Value.Is_Valid;
 782    end More_Entries;
 783
 784    ------------
 785    -- Rename --
 786    ------------
 787
 788    procedure Rename (Old_Name, New_Name : String) is
 789       Success : Boolean;
 790
 791    begin
 792       --  First, the invalid cases
 793
 794       if not Is_Valid_Path_Name (Old_Name)
 795         or else not Is_Valid_Path_Name (New_Name)
 796         or else (not Is_Regular_File (Old_Name)
 797                    and then not Is_Directory (Old_Name))
 798       then
 799          raise Name_Error;
 800
 801       elsif Is_Regular_File (New_Name) or Is_Directory (New_Name) then
 802          raise Use_Error;
 803
 804       else
 805          --  The implementation uses GNAT.OS_Lib.Rename_File
 806
 807          Rename_File (Old_Name, New_Name, Success);
 808
 809          if not Success then
 810             raise Use_Error;
 811          end if;
 812       end if;
 813    end Rename;
 814
 815    -------------------
 816    -- Set_Directory --
 817    -------------------
 818
 819    procedure Set_Directory (Directory : String) is
 820    begin
 821       --  The implementation uses GNAT.Directory_Operations.Change_Dir
 822
 823       Change_Dir (Dir_Name => Directory);
 824
 825    exception
 826       when Directory_Error =>
 827          raise Name_Error;
 828    end Set_Directory;
 829
 830    -----------------
 831    -- Simple_Name --
 832    -----------------
 833
 834    function Simple_Name (Name : String) return String is
 835    begin
 836       --  First, the invalid case
 837
 838       if not Is_Valid_Path_Name (Name) then
 839          raise Name_Error;
 840
 841       else
 842          --  Build the value to return with lower bound 1
 843
 844          --  The implementation uses GNAT.Directory_Operations.Base_Name
 845
 846          declare
 847             Value  : String := GNAT.Directory_Operations.Base_Name (Name);
 848             subtype Result is String (1 .. Value'Length);
 849          begin
 850             To_Lower_If_Case_Insensitive (Value);
 851             return Result (Value);
 852          end;
 853       end if;
 854    end Simple_Name;
 855
 856    function Simple_Name
 857      (Directory_Entry : Directory_Entry_Type) return String
 858    is
 859    begin
 860       --  First, the invalid case
 861
 862       if not Directory_Entry.Is_Valid then
 863          raise Status_Error;
 864
 865       else
 866          --  The value to return has already be computed
 867
 868          return To_String (Directory_Entry.Simple);
 869       end if;
 870    end Simple_Name;
 871
 872    ----------
 873    -- Size --
 874    ----------
 875
 876    function Size (Name : String) return File_Size is
 877       C_Name : String (1 .. Name'Length + 1);
 878
 879       function C_Size (Name : System.Address) return Long_Integer;
 880       pragma Import (C, C_Size, "__gnat_named_file_length");
 881
 882    begin
 883       --  First, the invalid case
 884
 885       if not Is_Regular_File (Name) then
 886          raise Name_Error;
 887
 888       else
 889          C_Name (1 .. Name'Length) := Name;
 890          C_Name (C_Name'Last) := ASCII.NUL;
 891          return File_Size (C_Size (C_Name'Address));
 892       end if;
 893    end Size;
 894
 895    function Size (Directory_Entry : Directory_Entry_Type) return File_Size is
 896    begin
 897       --  First, the invalid case
 898
 899       if not Directory_Entry.Is_Valid then
 900          raise Status_Error;
 901
 902       else
 903          --  The value to return has already be computed
 904
 905          return Size (To_String (Directory_Entry.Full));
 906       end if;
 907    end Size;
 908
 909    ------------------
 910    -- Start_Search --
 911    ------------------
 912
 913    procedure Start_Search
 914      (Search    : in out Search_Type;
 915       Directory : String;
 916       Pattern   : String;
 917       Filter    : Filter_Type := (others => True))
 918    is
 919    begin
 920       --  First, the invalid case
 921
 922       if not Is_Directory (Directory) then
 923          raise Name_Error;
 924       end if;
 925
 926       --  If needed, finalize Search
 927
 928       Finalize (Search);
 929
 930       --  Allocate the default data
 931
 932       Search.Value := new Search_Data;
 933
 934       begin
 935          --  Check the pattern
 936
 937          Search.Value.Pattern := Compile (Pattern, Glob => True);
 938
 939       exception
 940          when Error_In_Regexp =>
 941             Free (Search.Value);
 942             raise Name_Error;
 943       end;
 944
 945       --  Initialize some Search components
 946
 947       Search.Value.Filter := Filter;
 948       Search.Value.Name := To_Unbounded_String (Full_Name (Directory));
 949       Open (Search.Value.Dir, Directory);
 950       Search.Value.Is_Valid := True;
 951    end Start_Search;
 952
 953    ----------------------------------
 954    -- To_Lower_If_Case_Insensitive --
 955    ----------------------------------
 956
 957    procedure To_Lower_If_Case_Insensitive (S : in out String) is
 958    begin
 959       if not Is_Path_Name_Case_Sensitive then
 960          for J in S'Range loop
 961             S (J) := To_Lower (S (J));
 962          end loop;
 963       end if;
 964    end To_Lower_If_Case_Insensitive;
 965
 966 end Ada.Directories;