Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-16 Pascal Obry <o...@adacore.com>
* s-crtl.ads (mkdir): New routine, support encoding.
* adaint.h (__gnat_mkdir): Update spec to pass encoding.
* mkdir.c (__gnat_mkdir): Add encoding parameter.
* a-direct.adb (Create_Directory): Use CRTL.mkdir, parse encoding
in form parameter.
* g-dirope.adb (Make_Dir): Update to pass encoding parameter.
Index: a-direct.adb
===================================================================
--- a-direct.adb (revision 189515)
+++ a-direct.adb (working copy)
@@ -395,13 +395,8 @@
(New_Directory : String;
Form : String := "")
is
- pragma Unreferenced (Form);
-
C_Dir_Name : constant String := New_Directory & ASCII.NUL;
- function mkdir (Dir_Name : String) return Integer;
- pragma Import (C, mkdir, "__gnat_mkdir");
-
begin
-- First, the invalid case
@@ -410,10 +405,37 @@
"invalid new directory path name """ & New_Directory & '"';
else
- if mkdir (C_Dir_Name) /= 0 then
- raise Use_Error with
- "creation of new directory """ & New_Directory & """ failed";
- end if;
+ -- Acquire setting of encoding parameter
+
+ declare
+ Formstr : constant String := To_Lower (Form);
+
+ Encoding : CRTL.Filename_Encoding;
+ -- Filename encoding specified into the form parameter
+
+ V1, V2 : Natural;
+
+ begin
+ Form_Parameter (Formstr, "encoding", V1, V2);
+
+ if V1 = 0 then
+ Encoding := CRTL.Unspecified;
+
+ elsif Formstr (V1 .. V2) = "utf8" then
+ Encoding := CRTL.UTF8;
+
+ elsif Formstr (V1 .. V2) = "8bits" then
+ Encoding := CRTL.ASCII_8bits;
+
+ else
+ raise Use_Error with "invalid Form";
+ end if;
+
+ if CRTL.mkdir (C_Dir_Name, Encoding) /= 0 then
+ raise Use_Error with
+ "creation of new directory """ & New_Directory & """ failed";
+ end if;
+ end;
end if;
end Create_Directory;
@@ -425,8 +447,6 @@
(New_Directory : String;
Form : String := "")
is
- pragma Unreferenced (Form);
-
New_Dir : String (1 .. New_Directory'Length + 1);
Last : Positive := 1;
Start : Positive := 1;
@@ -487,7 +507,8 @@
"file """ & New_Dir (1 .. Last) & """ already exists";
else
- Create_Directory (New_Directory => New_Dir (1 .. Last));
+ Create_Directory
+ (New_Directory => New_Dir (1 .. Last), Form => Form);
end if;
end if;
end loop;
Index: g-dirope.adb
===================================================================
--- g-dirope.adb (revision 189515)
+++ g-dirope.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2010, AdaCore --
+-- Copyright (C) 1998-2012, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -605,11 +605,8 @@
procedure Make_Dir (Dir_Name : Dir_Name_Str) is
C_Dir_Name : constant String := Dir_Name & ASCII.NUL;
- function mkdir (Dir_Name : String) return Integer;
- pragma Import (C, mkdir, "__gnat_mkdir");
-
begin
- if mkdir (C_Dir_Name) /= 0 then
+ if CRTL.mkdir (C_Dir_Name, Unspecified) /= 0 then
raise Directory_Error;
end if;
end Make_Dir;
Index: s-crtl.ads
===================================================================
--- s-crtl.ads (revision 189515)
+++ s-crtl.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -165,6 +165,11 @@
function chdir (dir_name : String) return int;
pragma Import (C, chdir, "__gnat_chdir");
+ function mkdir
+ (dir_name : String;
+ encoding : Filename_Encoding := Unspecified) return int;
+ pragma Import (C, mkdir, "__gnat_mkdir");
+
function setvbuf
(stream : FILEs;
buffer : chars;
Index: mkdir.c
===================================================================
--- mkdir.c (revision 189515)
+++ mkdir.c (working copy)
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 2002-2009, Free Software Foundation, Inc. *
+ * Copyright (C) 2002-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -58,14 +58,20 @@
/* This function provides a portable binding to the mkdir function. */
int
-__gnat_mkdir (char *dir_name)
+__gnat_mkdir (char *dir_name, int encoding ATTRIBUTE_UNUSED)
{
#if defined (__vxworks) && !(defined (__RTP__) && (_WRS_VXWORKS_MINOR != 0))
return mkdir (dir_name);
#elif defined (__MINGW32__)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
- S2WSC (wname, dir_name, GNAT_MAX_PATH_LEN + 2);
+ if (encoding == Encoding_Unspecified)
+ S2WSC (wname, dir_name, GNAT_MAX_PATH_LEN);
+ else if (encoding == Encoding_UTF8)
+ S2WSU (wname, dir_name, GNAT_MAX_PATH_LEN);
+ else
+ S2WS (wname, dir_name, GNAT_MAX_PATH_LEN);
+
return _tmkdir (wname);
#else
return mkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO);
Index: adaint.h
===================================================================
--- adaint.h (revision 189515)
+++ adaint.h (working copy)
@@ -120,7 +120,7 @@
extern int __gnat_try_lock (char *, char *);
extern int __gnat_open_new (char *, int);
extern int __gnat_open_new_temp (char *, int);
-extern int __gnat_mkdir (char *);
+extern int __gnat_mkdir (char *, int);
extern int __gnat_stat (char *,
GNAT_STRUCT_STAT *);
extern int __gnat_unlink (char *);
