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