[Ada] Fix Set_Read_Only Win32 implementation
Arnaud Charlet
charlet@adacore.com
Tue Aug 5 08:47:00 GMT 2008
The UNIX behavior is that only the writable permission
was reset. The initial Win32 implementation was setting
the file as readable and revoking the write/executable
permissions. This is now fixed. At the same time, to avoid
any confusion, the Set_Read_Only routine has been made a
renaming of Reset_Writable.
Manually tested on i686-pc-mingw32
Tested on i686-pc-linux-gnu, committed on trunk
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.
-------------- next part --------------
Index: adaint.c
===================================================================
--- adaint.c (revision 138675)
+++ adaint.c (revision 138676)
@@ -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__)
Index: adaint.h
===================================================================
--- adaint.h (revision 138675)
+++ adaint.h (revision 138676)
@@ -102,7 +102,7 @@ extern int __gnat_is_directory (c
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);
Index: s-os_lib.adb
===================================================================
--- s-os_lib.adb (revision 138675)
+++ s-os_lib.adb (revision 138676)
@@ -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);
Index: s-os_lib.ads
===================================================================
--- s-os_lib.ads (revision 138675)
+++ s-os_lib.ads (revision 138676)
@@ -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
More information about the Gcc-patches
mailing list