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