From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Eli Zaretskii Newsgroups: gmane.lisp.guile.devel Subject: Fix 'dirname' and 'basename' on MS-Windows Date: Wed, 02 Jul 2014 19:13:05 +0300 Message-ID: <83simj3fji.fsf@gnu.org> References: <877g3xozs3.fsf@gnu.org> Reply-To: Eli Zaretskii NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Trace: ger.gmane.org 1404317619 12195 80.91.229.3 (2 Jul 2014 16:13:39 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 2 Jul 2014 16:13:39 +0000 (UTC) Cc: guile-devel@gnu.org To: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Jul 02 18:13:32 2014 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1X2NA2-0003Gy-Hl for guile-devel@m.gmane.org; Wed, 02 Jul 2014 18:13:30 +0200 Original-Received: from localhost ([::1]:55242 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1X2NA2-0001Bv-4I for guile-devel@m.gmane.org; Wed, 02 Jul 2014 12:13:30 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:46090) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1X2N9r-00019S-Eg for guile-devel@gnu.org; Wed, 02 Jul 2014 12:13:27 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1X2N9i-0002CM-5h for guile-devel@gnu.org; Wed, 02 Jul 2014 12:13:19 -0400 Original-Received: from mtaout23.012.net.il ([80.179.55.175]:55337) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1X2N9h-0002CE-O5; Wed, 02 Jul 2014 12:13:10 -0400 Original-Received: from conversion-daemon.a-mtaout23.012.net.il by a-mtaout23.012.net.il (HyperSendmail v2007.08) id <0N8300E00E1BMJ00@a-mtaout23.012.net.il>; Wed, 02 Jul 2014 19:13:08 +0300 (IDT) Original-Received: from HOME-C4E4A596F7 ([87.69.4.28]) by a-mtaout23.012.net.il (HyperSendmail v2007.08) with ESMTPA id <0N8300ELWEDVL540@a-mtaout23.012.net.il>; Wed, 02 Jul 2014 19:13:08 +0300 (IDT) In-reply-to: <877g3xozs3.fsf@gnu.org> X-012-Sender: halo1@inter.net.il X-detected-operating-system: by eggs.gnu.org: Solaris 10 X-Received-From: 80.179.55.175 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:17270 Archived-At: These 2 functions don't deal correctly with Windows file names with drive letters and with UNCs. The patch below fixes that. Incidentally, isn't the line in scm_basename marked below wrong? if (i == end) { if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0))) return scm_c_substring (filename, 0, 1); else return scm_dot_string; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< } else return scm_c_substring (filename, i+1, end+1); It is responsible for the following strange results: (basename ".foo" ".foo") => "." (basename "_foo" "_foo") => "." Also, isn't the following result wrong as well? (basename "/") => "/" I think all of these should return the empty string, "". Here's the proposed patch for supporting Windows file names. --- libguile/filesys.c~1 2014-06-29 16:13:30 +0300 +++ libguile/filesys.c 2014-07-02 14:03:08 +0300 @@ -448,6 +448,18 @@ is_file_name_separator (SCM c) return 0; } +static int +is_drive_letter (SCM c) +{ +#ifdef __MINGW32__ + if (SCM_CHAR (c) >= 'a' && SCM_CHAR (c) <= 'z') + return 1; + else if (SCM_CHAR (c) >= 'A' && SCM_CHAR (c) <= 'Z') + return 1; +#endif + return 0; +} + SCM_DEFINE (scm_stat, "stat", 1, 1, 0, (SCM object, SCM exception_on_error), "Return an object containing various information about the file\n" @@ -1518,24 +1530,60 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0 { long int i; unsigned long int len; + /* Length of prefix before the top-level slash. Always zero on + Posix hosts, but may be non-zero on Windows. */ + long prefix_len = 0; + int is_unc = 0; + unsigned long unc_end = 0; SCM_VALIDATE_STRING (1, filename); len = scm_i_string_length (filename); + if (len >= 2 + && is_drive_letter (scm_c_string_ref (filename, 0)) + && scm_is_eq (scm_c_string_ref (filename, 1), SCM_MAKE_CHAR (':'))) + { + prefix_len = 1; + if (len > 2 && is_file_name_separator (scm_c_string_ref (filename, 2))) + prefix_len++; + } +#ifdef __MINGW32__ + if (len > 1 + && is_file_name_separator (scm_c_string_ref (filename, 0)) + && is_file_name_separator (scm_c_string_ref (filename, 1))) + { + is_unc = 1; + prefix_len = 1; + } +#endif i = len - 1; - while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i))) + while (i >= prefix_len + && is_file_name_separator (scm_c_string_ref (filename, i))) --i; - while (i >= 0 && !is_file_name_separator (scm_c_string_ref (filename, i))) + if (is_unc) + unc_end = i + 1; + while (i >= prefix_len + && !is_file_name_separator (scm_c_string_ref (filename, i))) --i; - while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i))) + while (i >= prefix_len + && is_file_name_separator (scm_c_string_ref (filename, i))) --i; - if (i < 0) + if (i < prefix_len) { - if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0))) - return scm_c_substring (filename, 0, 1); + if (is_unc) + return scm_c_substring (filename, 0, unc_end); + else if (len > prefix_len + && is_file_name_separator (scm_c_string_ref (filename, prefix_len))) + return scm_c_substring (filename, 0, prefix_len + 1); +#ifdef __MINGW32__ + else if (len > prefix_len + && scm_is_eq (scm_c_string_ref (filename, 1), + SCM_MAKE_CHAR (':'))) + return scm_c_substring (filename, 0, prefix_len + 1); +#endif else return scm_dot_string; } @@ -1553,6 +1601,9 @@ SCM_DEFINE (scm_basename, "basename", 1, #define FUNC_NAME s_scm_basename { int i, j, len, end; + /* Length of prefix before the top-level slash. Always zero on + Posix hosts, but may be non-zero on Windows. */ + long prefix_len = 0; SCM_VALIDATE_STRING (1, filename); len = scm_i_string_length (filename); @@ -1564,11 +1615,17 @@ SCM_DEFINE (scm_basename, "basename", 1, SCM_VALIDATE_STRING (2, suffix); j = scm_i_string_length (suffix) - 1; } + if (len >= 2 + && is_drive_letter (scm_c_string_ref (filename, 0)) + && scm_is_eq (scm_c_string_ref (filename, 1), SCM_MAKE_CHAR (':'))) + prefix_len = 2; + i = len - 1; - while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i))) + while (i >= prefix_len + && is_file_name_separator (scm_c_string_ref (filename, i))) --i; end = i; - while (i >= 0 && j >= 0 + while (i >= prefix_len && j >= 0 && (scm_i_string_ref (filename, i) == scm_i_string_ref (suffix, j))) { @@ -1577,12 +1634,20 @@ SCM_DEFINE (scm_basename, "basename", 1, } if (j == -1) end = i; - while (i >= 0 && !is_file_name_separator (scm_c_string_ref (filename, i))) + while (i >= prefix_len + && !is_file_name_separator (scm_c_string_ref (filename, i))) --i; if (i == end) { - if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0))) - return scm_c_substring (filename, 0, 1); + if (len > prefix_len + && is_file_name_separator (scm_c_string_ref (filename, prefix_len))) + return scm_c_substring (filename, 0, prefix_len + 1); +#ifdef __MINGW32__ + else if (len > prefix_len + && scm_is_eq (scm_c_string_ref (filename, 1), + SCM_MAKE_CHAR (':'))) + return scm_c_substring (filename, 0, prefix_len + 1); +#endif else return scm_dot_string; }