From: Arnaud Charlet Date: Tue, 5 Aug 2008 08:41:30 +0000 (+0200) Subject: adaint.c, [...]: Fix the Set_Read_Only Win32 implementation. X-Git-Tag: releases/gcc-4.4.0~3378 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8b79ad42d8bb2cf2352fb6465ed7d31ebb9b1f54;p=thirdparty%2Fgcc.git adaint.c, [...]: Fix the Set_Read_Only Win32 implementation. 2008-08-05 Pascal Obry * adaint.c, adaint.h, s-os_lib.adb, s-os_lib.ads: Fix the Set_Read_Only Win32 implementation. From-SVN: r138676 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 017a55fe25f4..a55bd8cc12c3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2008-08-05 Javier Miranda + + * 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 + + * adaint.c, adaint.h, s-os_lib.adb, s-os_lib.ads: Fix the + Set_Read_Only Win32 implementation. + 2008-08-05 Thomas Quinot * exp_strm.adb: Minor reformatting (comments) diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 20f8d22ea212..320d9b2f4e53 100644 --- a/gcc/ada/adaint.c +++ b/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__) diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index a447c0fa58ae..423c7ece7dce 100644 --- a/gcc/ada/adaint.h +++ b/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); diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index ca19e5a973f4..8ba90aa13df1 100755 --- a/gcc/ada/s-os_lib.adb +++ b/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 -- ----------------------- @@ -2300,20 +2315,6 @@ package body System.OS_Lib is 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 -- -------------------- @@ -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); diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index f841558627ff..07fd3d9be586 100755 --- a/gcc/ada/s-os_lib.ads +++ b/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