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