adaint.c, [...]: Fix the Set_Read_Only Win32 implementation.

2008-08-05  Pascal Obry  <obry@adacore.com>

	* adaint.c, adaint.h, s-os_lib.adb, s-os_lib.ads: Fix the
	Set_Read_Only Win32 implementation.

From-SVN: r138676

gcc/ada/ChangeLog

+2008-08-05  Javier Miranda  <miranda@adacore.com>
+
+	* sem_util.adb (Collect_Interfaces_Info): Minor reformating.
+	* exp_ch3.adb (Build_Offset_To_Top_Functions): Code cleanup: the
+	implementation of this routine has been simplified.
+
+2008-08-05  Pascal Obry  <obry@adacore.com>
+
+	* adaint.c, adaint.h, s-os_lib.adb, s-os_lib.ads: Fix the
+	Set_Read_Only Win32 implementation.
+
 2008-08-05  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_strm.adb: Minor reformatting (comments)

gcc/ada/adaint.c

@@ -1927,14 +1927,14 @@ __gnat_set_executable (char *name)
 }
 
 void
-__gnat_set_readonly (char *name)
+__gnat_set_non_writable (char *name)
 {
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
   S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, SET_ACCESS, GENERIC_READ);
+  __gnat_set_OWNER_ACL (wname, REVOKE_ACCESS, GENERIC_WRITE);
   SetFileAttributes
     (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
 #elif ! defined (__vxworks) && ! defined(__nucleus__)

gcc/ada/adaint.h

@@ -102,7 +102,7 @@ extern int    __gnat_is_directory		   (char *);
 extern int    __gnat_is_writable_file		   (char *);
 extern int    __gnat_is_readable_file		   (char *name);
 extern int    __gnat_is_executable_file            (char *name);
-extern void   __gnat_set_readonly                  (char *name);
+extern void   __gnat_set_non_writable              (char *name);
 extern void   __gnat_set_writable                  (char *name);
 extern void   __gnat_set_executable                (char *name);
 extern int    __gnat_is_symbolic_link		   (char *name);

gcc/ada/s-os_lib.adb

@@ -589,9 +589,9 @@ package body System.OS_Lib is
       Mode     : Copy_Mode := Copy;
       Preserve : Attribute := Time_Stamps)
    is
-      Ada_Name : String_Access :=
-                   To_Path_String_Access
-                     (Name, C_String_Length (Name));
+      Ada_Name     : String_Access :=
+                       To_Path_String_Access
+                         (Name, C_String_Length (Name));
 
       Ada_Pathname : String_Access :=
                        To_Path_String_Access
@@ -648,9 +648,9 @@ package body System.OS_Lib is
                      To_Path_String_Access
                        (Source, C_String_Length (Source));
 
-      Ada_Dest : String_Access :=
-                   To_Path_String_Access
-                     (Dest, C_String_Length (Dest));
+      Ada_Dest   : String_Access :=
+                     To_Path_String_Access
+                       (Dest, C_String_Length (Dest));
    begin
       Copy_Time_Stamps (Ada_Source.all, Ada_Dest.all, Success);
       Free (Ada_Source);
@@ -872,7 +872,7 @@ package body System.OS_Lib is
    ---------------------
 
    function File_Time_Stamp (FD : File_Descriptor) return OS_Time is
-      function File_Time (FD    : File_Descriptor) return OS_Time;
+      function File_Time (FD : File_Descriptor) return OS_Time;
       pragma Import (C, File_Time, "__gnat_file_time_fd");
    begin
       return File_Time (FD);
@@ -1465,6 +1465,7 @@ package body System.OS_Lib is
 
       if Path_Len = 0 then
          return null;
+
       else
          Result := To_Path_String_Access (Path_Addr, Path_Len);
          Free (Path_Addr);
@@ -2269,6 +2270,20 @@ package body System.OS_Lib is
       Rename_File (C_Old_Name'Address, C_New_Name'Address, Success);
    end Rename_File;
 
+   ----------------------
+   -- Set_Non_Writable --
+   ----------------------
+
+   procedure Set_Non_Writable (Name : String) is
+      procedure C_Set_Non_Writable (Name : C_File_Name);
+      pragma Import (C, C_Set_Non_Writable, "__gnat_set_non_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_Non_Writable (C_Name (C_Name'First)'Address);
+   end Set_Non_Writable;
+
    -----------------------
    -- Set_Close_On_Exec --
    -----------------------
@@ -2301,20 +2316,6 @@ package body System.OS_Lib is
    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 --
    --------------------
 
@@ -2417,12 +2418,12 @@ package body System.OS_Lib is
    end Spawn;
 
    procedure Spawn
-     (Program_Name  : String;
-      Args          : Argument_List;
-      Output_File   : String;
-      Success       : out Boolean;
-      Return_Code   : out Integer;
-      Err_To_Out    : Boolean := True)
+     (Program_Name : String;
+      Args         : Argument_List;
+      Output_File  : String;
+      Success      : out Boolean;
+      Return_Code  : out Integer;
+      Err_To_Out   : Boolean := True)
    is
       FD : File_Descriptor;
 
@@ -2468,16 +2469,16 @@ package body System.OS_Lib is
          type Chars is array (Positive range <>) of aliased Character;
          type Char_Ptr is access constant Character;
 
-         Command_Len : constant Positive := Program_Name'Length + 1
-                                              + Args_Length (Args);
+         Command_Len  : constant Positive := Program_Name'Length + 1
+                                               + Args_Length (Args);
          Command_Last : Natural := 0;
-         Command : aliased Chars (1 .. Command_Len);
+         Command      : aliased Chars (1 .. Command_Len);
          --  Command contains all characters of the Program_Name and Args, all
          --  terminated by ASCII.NUL characters
 
-         Arg_List_Len : constant Positive := Args'Length + 2;
+         Arg_List_Len  : constant Positive := Args'Length + 2;
          Arg_List_Last : Natural := 0;
-         Arg_List : aliased array (1 .. Arg_List_Len) of Char_Ptr;
+         Arg_List      : aliased array (1 .. Arg_List_Len) of Char_Ptr;
          --  List with pointers to NUL-terminated strings of the Program_Name
          --  and the Args and terminated with a null pointer. We rely on the
          --  default initialization for the last null pointer.
@@ -2571,9 +2572,8 @@ package body System.OS_Lib is
       subtype Path_String is String (1 .. Path_Len);
       type    Path_String_Access is access Path_String;
 
-      function Address_To_Access is new
-        Ada.Unchecked_Conversion (Source => Address,
-                              Target => Path_String_Access);
+      function Address_To_Access is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Path_String_Access);
 
       Path_Access : constant Path_String_Access :=
                       Address_To_Access (Path_Addr);

gcc/ada/s-os_lib.ads

@@ -149,9 +149,9 @@ package System.OS_Lib is
       Hour   : out Hour_Type;
       Minute : out Minute_Type;
       Second : out Second_Type);
-   --  Analogous to the Split routine in Ada.Calendar, takes an OS_Time
-   --  and provides a representation of it as a set of component parts,
-   --  to be interpreted as a date point in UTC.
+   --  Analogous to the Split routine in Ada.Calendar, takes an OS_Time and
+   --  provides a representation of it as a set of component parts, to be
+   --  interpreted as a date point in UTC.
 
    ----------------
    -- File Stuff --
@@ -238,11 +238,11 @@ package System.OS_Lib is
    --  mode parameter is provided. Since this is a temporary file, there is no
    --  point in doing text translation on it.
    --
-   --  On some OSes, the maximum number of temp files that can be created with
-   --  this procedure may be limited. When the maximum is reached, this
-   --  procedure returns Invalid_FD. On some OSes, there may be a race
-   --  condition between processes trying to create temp files at the same
-   --  time in the same directory using this procedure.
+   --  On some operating systems, the maximum number of temp files that can be
+   --  created with this procedure may be limited. When the maximum is reached,
+   --  this procedure returns Invalid_FD. On some operating systems, there may
+   --  be a race condition between processes trying to create temp files at the
+   --  same time in the same directory using this procedure.
 
    procedure Create_Temp_File
      (FD   : out File_Descriptor;
@@ -498,27 +498,29 @@ package System.OS_Lib is
    --  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.
+   --  Change 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_Non_Writable (Name : String);
+   --  Change permissions on the named file to make it non-writable for its
+   --  owner. The readable and executable permissions are not modified.
+
+   procedure Set_Read_Only (Name : String) renames Set_Non_Writable;
+   --  This renaming is provided for backwards compatibility with previous
+   --  versions. The use of Set_Non_Writable is preferred (clearer name).
 
    procedure Set_Executable (Name : String);
-   --  Change the permissions on the named file to make it executable
-   --  for its owner.
+   --  Change 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
-   --  directories listed in the environment Path. If the Exec_Name doesn't
+   --  directories listed in the environment Path. If the Exec_Name does not
    --  have the executable suffix, it will be appended before the search.
-   --  Otherwise works like Locate_Regular_File below.
-   --  If the executable is not found, null is returned.
+   --  Otherwise works like Locate_Regular_File below. If the executable is
+   --  not found, null is returned.
    --
-   --  Note that this function allocates some memory for the returned value.
-   --  This memory needs to be deallocated after use.
+   --  Note that this function allocates memory for the returned value. This
+   --  memory needs to be deallocated after use.
 
    function Locate_Regular_File
      (File_Name : String;
@@ -544,10 +546,9 @@ package System.OS_Lib is
    --  the heap and should be freed after use to avoid storage leaks.
 
    function Get_Target_Debuggable_Suffix return String_Access;
-   --  Return the target debuggable suffix convention. Usually this is the
-   --  same as the convention for Get_Executable_Suffix. The result is
-   --  allocated on the heap and should be freed after use to avoid storage
-   --  leaks.
+   --  Return the target debuggable suffix convention. Usually this is the same
+   --  as the convention for Get_Executable_Suffix. The result is allocated on
+   --  the heap and should be freed after use to avoid storage leaks.
 
    function Get_Executable_Suffix return String_Access;
    --  Return the executable suffix convention. The result is allocated on the