Commit e01934b7 by Pascal Obry Committed by Arnaud Charlet

s-crtl.ads (mkdir): New routine, support encoding.

2012-07-16  Pascal Obry  <obry@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.

2012-07-16  Pascal Obry  <obry@adacore.com>

	* adaint.c: Minor reformatting.

From-SVN: r189525
parent 7a1c57d3
2012-07-16 Pascal Obry <obry@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.
2012-07-16 Pascal Obry <obry@adacore.com>
* adaint.c: Minor reformatting.
2012-07-16 Steven Bosscher <steven@gcc.gnu.org> 2012-07-16 Steven Bosscher <steven@gcc.gnu.org>
* gcc-interface/utils.c: Include timevar.h. * gcc-interface/utils.c: Include timevar.h.
......
...@@ -395,13 +395,8 @@ package body Ada.Directories is ...@@ -395,13 +395,8 @@ package body Ada.Directories is
(New_Directory : String; (New_Directory : String;
Form : String := "") Form : String := "")
is is
pragma Unreferenced (Form);
C_Dir_Name : constant String := New_Directory & ASCII.NUL; C_Dir_Name : constant String := New_Directory & ASCII.NUL;
function mkdir (Dir_Name : String) return Integer;
pragma Import (C, mkdir, "__gnat_mkdir");
begin begin
-- First, the invalid case -- First, the invalid case
...@@ -410,10 +405,37 @@ package body Ada.Directories is ...@@ -410,10 +405,37 @@ package body Ada.Directories is
"invalid new directory path name """ & New_Directory & '"'; "invalid new directory path name """ & New_Directory & '"';
else else
if mkdir (C_Dir_Name) /= 0 then -- 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 raise Use_Error with
"creation of new directory """ & New_Directory & """ failed"; "creation of new directory """ & New_Directory & """ failed";
end if; end if;
end;
end if; end if;
end Create_Directory; end Create_Directory;
...@@ -425,8 +447,6 @@ package body Ada.Directories is ...@@ -425,8 +447,6 @@ package body Ada.Directories is
(New_Directory : String; (New_Directory : String;
Form : String := "") Form : String := "")
is is
pragma Unreferenced (Form);
New_Dir : String (1 .. New_Directory'Length + 1); New_Dir : String (1 .. New_Directory'Length + 1);
Last : Positive := 1; Last : Positive := 1;
Start : Positive := 1; Start : Positive := 1;
...@@ -487,7 +507,8 @@ package body Ada.Directories is ...@@ -487,7 +507,8 @@ package body Ada.Directories is
"file """ & New_Dir (1 .. Last) & """ already exists"; "file """ & New_Dir (1 .. Last) & """ already exists";
else else
Create_Directory (New_Directory => New_Dir (1 .. Last)); Create_Directory
(New_Directory => New_Dir (1 .. Last), Form => Form);
end if; end if;
end if; end if;
end loop; end loop;
......
...@@ -80,10 +80,10 @@ extern "C" { ...@@ -80,10 +80,10 @@ extern "C" {
#ifdef IN_RTS #ifdef IN_RTS
#include "tconfig.h" #include "tconfig.h"
#include "tsystem.h" #include "tsystem.h"
#include <sys/stat.h> #include <sys/stat.h>
#include <fcntl.h> #include <fcntl.h>
#include <time.h> #include <time.h>
#ifdef VMS #ifdef VMS
#include <unixio.h> #include <unixio.h>
#endif #endif
......
...@@ -120,7 +120,7 @@ extern int __gnat_symlink (char *, char *); ...@@ -120,7 +120,7 @@ extern int __gnat_symlink (char *, char *);
extern int __gnat_try_lock (char *, char *); extern int __gnat_try_lock (char *, char *);
extern int __gnat_open_new (char *, int); extern int __gnat_open_new (char *, int);
extern int __gnat_open_new_temp (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 *, extern int __gnat_stat (char *,
GNAT_STRUCT_STAT *); GNAT_STRUCT_STAT *);
extern int __gnat_unlink (char *); extern int __gnat_unlink (char *);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -605,11 +605,8 @@ package body GNAT.Directory_Operations is ...@@ -605,11 +605,8 @@ package body GNAT.Directory_Operations is
procedure Make_Dir (Dir_Name : Dir_Name_Str) is procedure Make_Dir (Dir_Name : Dir_Name_Str) is
C_Dir_Name : constant String := Dir_Name & ASCII.NUL; C_Dir_Name : constant String := Dir_Name & ASCII.NUL;
function mkdir (Dir_Name : String) return Integer;
pragma Import (C, mkdir, "__gnat_mkdir");
begin begin
if mkdir (C_Dir_Name) /= 0 then if CRTL.mkdir (C_Dir_Name, Unspecified) /= 0 then
raise Directory_Error; raise Directory_Error;
end if; end if;
end Make_Dir; end Make_Dir;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * 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 * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -58,14 +58,20 @@ ...@@ -58,14 +58,20 @@
/* This function provides a portable binding to the mkdir function. */ /* This function provides a portable binding to the mkdir function. */
int int
__gnat_mkdir (char *dir_name) __gnat_mkdir (char *dir_name, int encoding ATTRIBUTE_UNUSED)
{ {
#if defined (__vxworks) && !(defined (__RTP__) && (_WRS_VXWORKS_MINOR != 0)) #if defined (__vxworks) && !(defined (__RTP__) && (_WRS_VXWORKS_MINOR != 0))
return mkdir (dir_name); return mkdir (dir_name);
#elif defined (__MINGW32__) #elif defined (__MINGW32__)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; 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); return _tmkdir (wname);
#else #else
return mkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO); return mkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -165,6 +165,11 @@ package System.CRTL is ...@@ -165,6 +165,11 @@ package System.CRTL is
function chdir (dir_name : String) return int; function chdir (dir_name : String) return int;
pragma Import (C, chdir, "__gnat_chdir"); 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 function setvbuf
(stream : FILEs; (stream : FILEs;
buffer : chars; buffer : chars;
......
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