ada: Fix Ada.Text_IO.Delete with "encoding=8bits" form

Before this patch, on Windows, file with non-ASCII Latin1 names could be created
with Ada.Text_IO.Create by passing "encoding=8bits" through the Form
parameter and a Latin1-encoded string through the Name parameter,
but calling Ada.Text_IO.Delete on them raised an illegitimate exception.

This patch fixes this by making the wrappers of the unlink system function
aware of the encoding value passed through the Form parameter. It also
removes an unnecessary curly-brace block.

gcc/ada/

	* adaint.c (__gnat_unlink): Add new parameter and fix text
	conversion on Windows. Remove unnecessary curly braces.
	* adaint.h (__gnat_unlink): Add new parameter.
	* libgnat/i-cstrea.ads (unlink): Adapt to __gnat_unlink signature
	change.
	* libgnat/i-cstrea.adb (unlink): New Subprogram definition.
	* libgnat/s-crtl.ads (unlink): Adapt to __gnat_unlink signature
	change.
	* libgnat/s-fileio.adb (Delete): Pass encoding argument to unlink.
This commit is contained in:
Ronan Desplanques 2023-10-23 16:02:07 +02:00 committed by Marc Poulhiès
parent 50e0095904
commit a5fbba52e9
6 changed files with 24 additions and 10 deletions

View file

@ -747,15 +747,19 @@ __gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
/* Delete a file. */
int
__gnat_unlink (char *path)
__gnat_unlink (char *path, int encoding ATTRIBUTE_UNUSED)
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
TCHAR wpath[GNAT_MAX_PATH_LEN];
if (encoding == Encoding_Unspecified)
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _tunlink (wpath);
}
else if (encoding == Encoding_UTF8)
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
else
S2WS (wpath, path, GNAT_MAX_PATH_LEN);
return _tunlink (wpath);
#else
return unlink (path);
#endif

View file

@ -172,7 +172,7 @@ extern int __gnat_open_new_temp (char *, int);
extern int __gnat_mkdir (char *, int);
extern int __gnat_stat (char *,
GNAT_STRUCT_STAT *);
extern int __gnat_unlink (char *);
extern int __gnat_unlink (char *, int encoding);
extern int __gnat_rename (char *, char *);
extern int __gnat_chdir (char *);
extern int __gnat_rmdir (char *);

View file

@ -130,4 +130,13 @@ package body Interfaces.C_Streams is
return C_setvbuf (stream, buffer, mode, size);
end setvbuf;
------------
-- unlink --
------------
function unlink (filename : chars) return int is
begin
return System.CRTL.unlink (filename);
end unlink;
end Interfaces.C_Streams;

View file

@ -197,8 +197,7 @@ package Interfaces.C_Streams is
function ungetc (c : int; stream : FILEs) return int
renames System.CRTL.ungetc;
function unlink (filename : chars) return int
renames System.CRTL.unlink;
function unlink (filename : chars) return int;
---------------------
-- Extra functions --

View file

@ -220,7 +220,8 @@ package System.CRTL is
function ungetc (c : int; stream : FILEs) return int;
pragma Import (C, ungetc, "ungetc");
function unlink (filename : chars) return int;
function unlink (filename : chars;
encoding : Filename_Encoding := Unspecified) return int;
pragma Import (C, unlink, "__gnat_unlink");
function open (filename : chars; oflag : int) return int;

View file

@ -350,6 +350,7 @@ package body System.File_IO is
declare
Filename : aliased constant String := File.Name.all;
Is_Temporary_File : constant Boolean := File.Is_Temporary_File;
Encoding : constant CRTL.Filename_Encoding := File.Encoding;
begin
Close (File_Ptr);
@ -360,7 +361,7 @@ package body System.File_IO is
-- it's a temporary file, then closing it already unlinked it.
if not Is_Temporary_File then
if unlink (Filename'Address) = -1 then
if System.CRTL.unlink (Filename'Address, Encoding) = -1 then
raise Use_Error with OS_Lib.Errno_Message;
end if;
end if;