g-os_lib.ads, [...] (Set_Executable, [...]): New subprograms.

2004-10-26  Thomas Quinot  <quinot@act-europe.fr>

	* g-os_lib.ads, g-os_lib.adb (Set_Executable, Set_Writable,
	Set_Read_Only): New subprograms.
	These new routines allow the user to set or unset the Owner execute
	and Owner write permission flags on a file.

	* makegpr.adb, mlib.adb, mlib-prj.adb: Use
	GNAT.OS_Lib.Set_Executable instead of rolling our own.

From-SVN: r89654

5 files changed, 58 insertions, 20 deletions

diff --git a/gcc/ada/g-os_lib.adb b/gcc/ada/g-os_lib.adb
index 75c82e5..d0db36e 100644
--- a/gcc/ada/g-os_lib.adb
+++ b/gcc/ada/g-os_lib.adb
@@ -2056,6 +2056,48 @@ package body GNAT.OS_Lib is
       Rename_File (C_Old_Name'Address, C_New_Name'Address, Success);
    end Rename_File;
 
+   --------------------
+   -- Set_Executable --
+   --------------------
+
+   procedure Set_Executable (Name : String) is
+      procedure C_Set_Executable (Name : C_File_Name);
+      pragma Import (C, C_Set_Executable, "__gnat_set_executable");
+      C_Name : aliased String (Name'First .. Name'Last + 1);
+   begin
+      C_Name (Name'Range)  := Name;
+      C_Name (C_Name'Last) := ASCII.NUL;
+      C_Set_Executable (C_Name (C_Name'First)'Address);
+   end Set_Executable;
+
+   --------------------
+   -- Set_Read_Only --
+   --------------------
+
+   procedure Set_Read_Only (Name : String) is
+      procedure C_Set_Read_Only (Name : C_File_Name);
+      pragma Import (C, C_Set_Read_Only, "__gnat_set_readonly");
+      C_Name : aliased String (Name'First .. Name'Last + 1);
+   begin
+      C_Name (Name'Range)  := Name;
+      C_Name (C_Name'Last) := ASCII.NUL;
+      C_Set_Read_Only (C_Name (C_Name'First)'Address);
+   end Set_Read_Only;
+
+   --------------------
+   -- Set_Writable --
+   --------------------
+
+   procedure Set_Writable (Name : String) is
+      procedure C_Set_Writable (Name : C_File_Name);
+      pragma Import (C, C_Set_Writable, "__gnat_set_writable");
+      C_Name : aliased String (Name'First .. Name'Last + 1);
+   begin
+      C_Name (Name'Range)  := Name;
+      C_Name (C_Name'Last) := ASCII.NUL;
+      C_Set_Writable (C_Name (C_Name'First)'Address);
+   end Set_Writable;
+
    ------------
    -- Setenv --
    ------------
diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads
index d886825..2db605b 100644
--- a/gcc/ada/g-os_lib.ads
+++ b/gcc/ada/g-os_lib.ads
@@ -470,6 +470,18 @@ pragma Elaborate_Body (OS_Lib);
    --  contains the name of the file to which it is linked. Symbolic links may
    --  span file systems and may refer to directories.
 
+   procedure Set_Writable (Name : String);
+   --  Change the permissions on the named file to make it writable
+   --  for its owner.
+
+   procedure Set_Read_Only (Name : String);
+   --  Change the permissions on the named file to make it non-writable
+   --  for its owner.
+
+   procedure Set_Executable (Name : String);
+   --  Change the permissions on the named file to make it executable
+   --  for its owner.
+
    function Locate_Exec_On_Path
      (Exec_Name : String) return String_Access;
    --  Try to locate an executable whose name is given by Exec_Name in the
@@ -562,9 +574,7 @@ pragma Elaborate_Body (OS_Lib);
    --  Returns Invalid_Time is Name doesn't correspond to an existing file.
 
    function Is_Regular_File (Name : C_File_Name) return Boolean;
-
    function Is_Directory (Name : C_File_Name) return Boolean;
-
    function Is_Readable_File (Name : C_File_Name) return Boolean;
    function Is_Writable_File (Name : C_File_Name) return Boolean;
    function Is_Symbolic_Link (Name : C_File_Name) return Boolean;
diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb
index 30f1519..8faf04d 100644
--- a/gcc/ada/makegpr.adb
+++ b/gcc/ada/makegpr.adb
@@ -3315,12 +3315,6 @@ package body Makegpr is
             Change_Dir (Object_Dir);
 
             declare
-               procedure Set_Executable (Name : System.Address);
-               pragma Import
-                 (C, Set_Executable, "__gnat_set_executable");
-
-               Name : constant String := Cpp_Linker & ASCII.NUL;
-
                File : Ada.Text_IO.File_Type;
                use Ada.Text_IO;
 
@@ -3336,7 +3330,7 @@ package body Makegpr is
                   " $* ${LIBGCC}");
 
                Close (File);
-               Set_Executable (Name (Name'First)'Address);
+               Set_Executable (Cpp_Linker);
             end;
          end if;
       end Choose_C_Plus_Plus_Link_Process;
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 1bfe6b1..0af9b8f 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -1638,9 +1638,6 @@ package body MLib.Prj is
 
       Disregard : Boolean;
 
-      procedure Set_Writable (Name : System.Address);
-      pragma Import (C, Set_Writable, "__gnat_set_writable");
-
    begin
       Get_Name_String (Directory);
 
@@ -1667,8 +1664,7 @@ package body MLib.Prj is
          exit when Last = 0;
 
          if Is_Regular_File (Name (1 .. Last)) then
-            Name (Last + 1) := ASCII.NUL;
-            Set_Writable (Name (1)'Address);
+            Set_Writable (Name (1 .. Last));
             Delete_File (Name (1 .. Last), Disregard);
          end if;
       end loop;
diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb
index 8e6d0e3..df8796f 100644
--- a/gcc/ada/mlib.adb
+++ b/gcc/ada/mlib.adb
@@ -37,8 +37,6 @@ with MLib.Utl; use MLib.Utl;
 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 with GNAT.OS_Lib;               use GNAT.OS_Lib;
 
-with System;
-
 package body MLib is
 
    -------------------
@@ -107,9 +105,6 @@ package body MLib is
       To_Dir    : constant String := Get_Name_String (To);
       Interface : Boolean := False;
 
-      procedure Set_Readonly (Name : System.Address);
-      pragma Import (C, Set_Readonly, "__gnat_set_readonly");
-
       procedure Verbose_Copy (Index : Positive);
       --  In verbose mode, output a message that the indexed file is copied
       --  to the destination directory.
@@ -264,7 +259,8 @@ package body MLib is
                               Success := Status and Actual_Len = Len + 3;
 
                               if Success then
-                                 Set_Readonly (Name_Buffer'Address);
+                                 Set_Read_Only (
+                                   Name_Buffer (1 .. Name_Len - 1));
                               end if;
                            end if;
                         end if;