The Ada Program: dir.adb

  1 with Interfaces.C, Interfaces.C.Pointers; use Interfaces;
  2 with Ada.Text_IO;  use Ada;
  3 With Ada.Characters.Latin_1;
  4 with Unchecked_Conversion;
  5 
  6 procedure Dir is
  7 
  8 
  9    type Char_Array is array (Natural range <>) of aliased C.char;
 10    Terminator: C.char := C.To_C (Characters.Latin_1.Nul);
 11 
 12 
 13    package C_Pointers is new C.Pointers (Natural, C.char, Char_Array, Terminator);
 14    subtype char_ptr is C_Pointers.Pointer;
 15 
 16    type PA is access Char_Array;
 17    function To_Pointer is new Unchecked_Conversion (PA, C_Pointers.Pointer);
 18 
 19 
 20    function Value (CA: Char_Array) return String is
 21       X: String (CA'First..CA'Last);
 22    begin
 23       for I in X'Range loop
 24          X(I) := C.To_Ada (CA(I));
 25       end loop;
 26       return X;
 27    end Value;
 28 
 29    function To_Ada (P: char_ptr) return String is
 30    begin
 31       return (Value (C_Pointers.Value (P)));
 32    end To_Ada;
 33 
 34    function Value (S: String) return Char_Array is
 35       X: Char_Array (S'First..S'Last+1);
 36    begin
 37       for I in X'Range loop
 38          X(I) := C.To_C (S(I));
 39       end loop;
 40       X(X'Last+1) := Terminator;
 41       return X;
 42    end Value;
 43 
 44    function To_C (S: String) return char_ptr is
 45        P: PA := new Char_Array' (Value (S));
 46    begin
 47       return (To_Pointer (P));
 48    end To_C;
 49 
 50 --     char *getwd (char *pathname);
 51 --     int chdir(const char *path);
 52 
 53    -- "getwd" is found in /usr/lib/libc.a which is linked in automatically
 54    function GetWD (Pathname: char_ptr) return char_ptr;
 55    pragma Import (C, GetWD, "getwd");
 56 
 57    function GetWD return String is
 58       Buffer: char_ptr;
 59       Result: char_ptr := GetWD (Buffer);
 60    begin
 61       return To_Ada (Result);
 62    end GetWD;
 63 
 64    -- "chdir" is found in /usr/lib/libc.a which is linked in automatically
 65    function Chdir (Pathname: char_ptr) return C.int;
 66    pragma Import (C, chdir, "chdir");
 67 
 68    procedure ChWD (Path: String) is
 69       Result: C.int;
 70    begin
 71       Text_IO.Put_Line (Path);
 72       Result := Chdir (To_C (Path));
 73    end ChWD;
 74 
 75 begin
 76 
 77    Text_IO.Put_Line (GetWD);
 78 
 79     ChWd ("..");
 80 
 81    Text_IO.Put_Line (GetWD);
 82 
 83 end Dir;