From patchwork Mon Jul 16 12:10:16 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 171176 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id F39AD2C00F7 for ; Mon, 16 Jul 2012 22:11:01 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1343045462; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=GbLbn0+mLWc77h+ON7GT qxWmDhs=; b=sIIqgjtcFUwRpB4kffnvDebLeEW9/n4azd9UP0TRLiX6xSotLxpM DGK1Omm1TjD0uxDzg3bYCTMfuKiy1H/9BCUI0gncP9qdsZaoy2nw/P6TQQfMPh2o OCKkS57JqjWXqt0GEXjTfEs/4SbYm+mSHm3lz7c2t5LeIG3yUneLayM= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=RTuXiLjJrJqdDffTSDkA6TKavOoHv2q7y1wQhA+pj6wUh/tXj6KGPzUFVpWreB p+8IesRMDk30HcTQBYtrIie7r1qmz8sjQgSYyvtMgM7Ht+/0WqqTbhmqPdDJxR0b 94xTQaCXtnCpPjaHnnTcvMHEctRDO4kTkPcSUFXEKP1Eg=; Received: (qmail 32140 invoked by alias); 16 Jul 2012 12:10:47 -0000 Received: (qmail 32081 invoked by uid 22791); 16 Jul 2012 12:10:33 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO, TW_TM, TW_TV, TW_VB X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 16 Jul 2012 12:10:19 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 195261C6B69; Mon, 16 Jul 2012 08:10:17 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id LvtJKF9V1mXV; Mon, 16 Jul 2012 08:10:17 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id EB6501C69B4; Mon, 16 Jul 2012 08:10:16 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id E57553FF09; Mon, 16 Jul 2012 08:10:16 -0400 (EDT) Date: Mon, 16 Jul 2012 08:10:16 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Pascal Obry Subject: [Ada] Add support for encoding in Create_Directory and Create_Path. Message-ID: <20120716121016.GA1385@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Tested on x86_64-pc-linux-gnu, committed on trunk 2012-07-16 Pascal Obry * 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 *);