Commit 55cc1a05 by Arnaud Charlet

[multiple changes]

2009-04-15  Pascal Obry  <obry@adacore.com>

	Add support for Win32 native encoding for delete/rename routines.
	
	* adaint.c (__gnat_unlink): New routine.
	(__gnat_rename): New routine.
	Simple wrapper routines used to convert to proper encoding on
	Windows.

	* s-os_lib.adb: Use __gnat_unlink and __gnat_rename instead of direct
	call to the C library.

	* g-sercom-mingw.adb, s-win32.ads: Update Win32 binding.

2009-04-15  Robert Dewar  <dewar@adacore.com>

	* s-tassta.adb: Minor reformatting

From-SVN: r146101
parent 1f6821b4
2009-04-15 Pascal Obry <obry@adacore.com>
Add support for Win32 native encoding for delete/rename routines.
* adaint.c (__gnat_unlink): New routine.
(__gnat_rename): New routine.
Simple wrapper routines used to convert to proper encoding on
Windows.
* s-os_lib.adb: Use __gnat_unlink and __gnat_rename instead of direct
call to the C library.
* g-sercom-mingw.adb, s-win32.ads: Update Win32 binding.
2009-04-15 Robert Dewar <dewar@adacore.com>
* s-tassta.adb: Minor reformatting
2009-04-15 Robert Dewar <dewar@adacore.com> 2009-04-15 Robert Dewar <dewar@adacore.com>
* frontend.adb (Frontend): Set proper default for * frontend.adb (Frontend): Set proper default for
...@@ -694,6 +694,41 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED, ...@@ -694,6 +694,41 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
#endif #endif
} }
/* Delete a file. */
int
__gnat_unlink (char *path)
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
return _tunlink (wpath);
}
#else
return unlink (path);
#endif
}
/* Rename a file. */
int
__gnat_rename (char *from, char *to)
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
{
TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
S2WSU (wfrom, from, GNAT_MAX_PATH_LEN);
S2WSU (wto, to, GNAT_MAX_PATH_LEN);
return _trename (wfrom, wto);
}
#else
return rename (from, to);
#endif
}
FILE * FILE *
__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
{ {
......
...@@ -106,7 +106,7 @@ package body GNAT.Serial_Communications is ...@@ -106,7 +106,7 @@ package body GNAT.Serial_Communications is
Success := CloseHandle (HANDLE (Port.H.all)); Success := CloseHandle (HANDLE (Port.H.all));
end if; end if;
Port.H.all := CreateFile Port.H.all := CreateFileA
(lpFileName => C_Name (C_Name'First)'Address, (lpFileName => C_Name (C_Name'First)'Address,
dwDesiredAccess => GENERIC_READ or GENERIC_WRITE, dwDesiredAccess => GENERIC_READ or GENERIC_WRITE,
dwShareMode => 0, dwShareMode => 0,
......
...@@ -848,7 +848,7 @@ package body System.OS_Lib is ...@@ -848,7 +848,7 @@ package body System.OS_Lib is
R : Integer; R : Integer;
function unlink (A : Address) return Integer; function unlink (A : Address) return Integer;
pragma Import (C, unlink, "unlink"); pragma Import (C, unlink, "__gnat_unlink");
begin begin
R := unlink (Name); R := unlink (Name);
...@@ -2246,7 +2246,7 @@ package body System.OS_Lib is ...@@ -2246,7 +2246,7 @@ package body System.OS_Lib is
Success : out Boolean) Success : out Boolean)
is is
function rename (From, To : Address) return Integer; function rename (From, To : Address) return Integer;
pragma Import (C, rename, "rename"); pragma Import (C, rename, "__gnat_rename");
R : Integer; R : Integer;
begin begin
R := rename (Old_Name, New_Name); R := rename (Old_Name, New_Name);
......
...@@ -1388,6 +1388,8 @@ package body System.Tasking.Stages is ...@@ -1388,6 +1388,8 @@ package body System.Tasking.Stages is
-- unwound. The common notification routine has been called at the -- unwound. The common notification routine has been called at the
-- raise point already. -- raise point already.
-- Lock to prevent unsynchronized output
Initialization.Task_Lock (Self_Id); Initialization.Task_Lock (Self_Id);
To_Stderr ("task "); To_Stderr ("task ");
......
...@@ -82,51 +82,53 @@ package System.Win32 is ...@@ -82,51 +82,53 @@ package System.Win32 is
-- Files -- -- Files --
----------- -----------
GENERIC_READ : constant := 16#80000000#; CP_UTF8 : constant := 65001;
GENERIC_WRITE : constant := 16#40000000#;
GENERIC_READ : constant := 16#80000000#;
CREATE_NEW : constant := 1; GENERIC_WRITE : constant := 16#40000000#;
CREATE_ALWAYS : constant := 2;
OPEN_EXISTING : constant := 3; CREATE_NEW : constant := 1;
OPEN_ALWAYS : constant := 4; CREATE_ALWAYS : constant := 2;
TRUNCATE_EXISTING : constant := 5; OPEN_EXISTING : constant := 3;
OPEN_ALWAYS : constant := 4;
FILE_SHARE_DELETE : constant := 16#00000004#; TRUNCATE_EXISTING : constant := 5;
FILE_SHARE_READ : constant := 16#00000001#;
FILE_SHARE_WRITE : constant := 16#00000002#; FILE_SHARE_DELETE : constant := 16#00000004#;
FILE_SHARE_READ : constant := 16#00000001#;
FILE_BEGIN : constant := 0; FILE_SHARE_WRITE : constant := 16#00000002#;
FILE_CURRENT : constant := 1;
FILE_END : constant := 2; FILE_BEGIN : constant := 0;
FILE_CURRENT : constant := 1;
PAGE_NOACCESS : constant := 16#0001#; FILE_END : constant := 2;
PAGE_READONLY : constant := 16#0002#;
PAGE_READWRITE : constant := 16#0004#; PAGE_NOACCESS : constant := 16#0001#;
PAGE_WRITECOPY : constant := 16#0008#; PAGE_READONLY : constant := 16#0002#;
PAGE_EXECUTE : constant := 16#0010#; PAGE_READWRITE : constant := 16#0004#;
PAGE_WRITECOPY : constant := 16#0008#;
FILE_MAP_ALL_ACCESS : constant := 16#F001f#; PAGE_EXECUTE : constant := 16#0010#;
FILE_MAP_READ : constant := 4;
FILE_MAP_WRITE : constant := 2; FILE_MAP_ALL_ACCESS : constant := 16#F001f#;
FILE_MAP_COPY : constant := 1; FILE_MAP_READ : constant := 4;
FILE_MAP_WRITE : constant := 2;
FILE_ADD_FILE : constant := 16#0002#; FILE_MAP_COPY : constant := 1;
FILE_ADD_SUBDIRECTORY : constant := 16#0004#;
FILE_APPEND_DATA : constant := 16#0004#; FILE_ADD_FILE : constant := 16#0002#;
FILE_CREATE_PIPE_INSTANCE : constant := 16#0004#; FILE_ADD_SUBDIRECTORY : constant := 16#0004#;
FILE_DELETE_CHILD : constant := 16#0040#; FILE_APPEND_DATA : constant := 16#0004#;
FILE_EXECUTE : constant := 16#0020#; FILE_CREATE_PIPE_INSTANCE : constant := 16#0004#;
FILE_LIST_DIRECTORY : constant := 16#0001#; FILE_DELETE_CHILD : constant := 16#0040#;
FILE_READ_ATTRIBUTES : constant := 16#0080#; FILE_EXECUTE : constant := 16#0020#;
FILE_READ_DATA : constant := 16#0001#; FILE_LIST_DIRECTORY : constant := 16#0001#;
FILE_READ_EA : constant := 16#0008#; FILE_READ_ATTRIBUTES : constant := 16#0080#;
FILE_TRAVERSE : constant := 16#0020#; FILE_READ_DATA : constant := 16#0001#;
FILE_WRITE_ATTRIBUTES : constant := 16#0100#; FILE_READ_EA : constant := 16#0008#;
FILE_WRITE_DATA : constant := 16#0002#; FILE_TRAVERSE : constant := 16#0020#;
FILE_WRITE_EA : constant := 16#0010#; FILE_WRITE_ATTRIBUTES : constant := 16#0100#;
STANDARD_RIGHTS_READ : constant := 16#20000#; FILE_WRITE_DATA : constant := 16#0002#;
STANDARD_RIGHTS_WRITE : constant := 16#20000#; FILE_WRITE_EA : constant := 16#0010#;
SYNCHRONIZE : constant := 16#100000#; STANDARD_RIGHTS_READ : constant := 16#20000#;
STANDARD_RIGHTS_WRITE : constant := 16#20000#;
SYNCHRONIZE : constant := 16#100000#;
FILE_ATTRIBUTE_READONLY : constant := 16#00000001#; FILE_ATTRIBUTE_READONLY : constant := 16#00000001#;
FILE_ATTRIBUTE_HIDDEN : constant := 16#00000002#; FILE_ATTRIBUTE_HIDDEN : constant := 16#00000002#;
...@@ -159,6 +161,16 @@ package System.Win32 is ...@@ -159,6 +161,16 @@ package System.Win32 is
bInheritHandle : BOOL; bInheritHandle : BOOL;
end record; end record;
function CreateFileA
(lpFileName : Address;
dwDesiredAccess : DWORD;
dwShareMode : DWORD;
lpSecurityAttributes : access SECURITY_ATTRIBUTES;
dwCreationDisposition : DWORD;
dwFlagsAndAttributes : DWORD;
hTemplateFile : HANDLE) return HANDLE;
pragma Import (Stdcall, CreateFileA, "CreateFileA");
function CreateFile function CreateFile
(lpFileName : Address; (lpFileName : Address;
dwDesiredAccess : DWORD; dwDesiredAccess : DWORD;
...@@ -167,7 +179,7 @@ package System.Win32 is ...@@ -167,7 +179,7 @@ package System.Win32 is
dwCreationDisposition : DWORD; dwCreationDisposition : DWORD;
dwFlagsAndAttributes : DWORD; dwFlagsAndAttributes : DWORD;
hTemplateFile : HANDLE) return HANDLE; hTemplateFile : HANDLE) return HANDLE;
pragma Import (Stdcall, CreateFile, "CreateFileA"); pragma Import (Stdcall, CreateFile, "CreateFileW");
function GetFileSize function GetFileSize
(hFile : HANDLE; (hFile : HANDLE;
...@@ -220,6 +232,15 @@ package System.Win32 is ...@@ -220,6 +232,15 @@ package System.Win32 is
function UnmapViewOfFile (lpBaseAddress : System.Address) return BOOL; function UnmapViewOfFile (lpBaseAddress : System.Address) return BOOL;
pragma Import (Stdcall, UnmapViewOfFile, "UnmapViewOfFile"); pragma Import (Stdcall, UnmapViewOfFile, "UnmapViewOfFile");
function MultiByteToWideChar
(CodePage : WORD;
dwFlags : DWORD;
lpMultiByteStr : System.Address;
cchMultiByte : WORD;
lpWideCharStr : System.Address;
cchWideChar : WORD) return BOOL;
pragma Import (Stdcall, MultiByteToWideChar, "MultiByteToWideChar");
------------------------ ------------------------
-- System Information -- -- System Information --
------------------------ ------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment