mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

Merge from stable-2.2

Browse source
This commit is contained in:
Andy Wingo 2019-08-02 14:31:46 +02:00
commit 0a78d39b77
2 changed files with 20 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/filesys.c
View file

@ -1608,11 +1608,20 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
c_filename = scm_to_utf8_string (filename); c_filename = scm_to_utf8_string (filename);
scm_dynwind_free (c_filename); scm_dynwind_free (c_filename);
c_last_component = last_component (c_filename); if (strcmp (c_filename, "/") == 0
if (!c_last_component) || strcmp (c_filename, "//") == 0)
res = filename; /* As per
<http://pubs.opengroup.org/onlinepubs/9699919799/functions/basename.html>,
"/" and "//" are treated specially. */
res = scm_from_utf8_string ("/");
else else
res = scm_from_utf8_string (c_last_component); {
c_last_component = last_component (c_filename);
if (!c_last_component)
res = filename;
else
res = scm_from_utf8_string (c_last_component);
}
scm_dynwind_end (); scm_dynwind_end ();
if (!SCM_UNBNDP (suffix) && if (!SCM_UNBNDP (suffix) &&

8
test-suite/tests/filesys.test
View file

@ -1,6 +1,6 @@
;;;; filesys.test --- test file system functions -*- scheme -*- ;;;; filesys.test --- test file system functions -*- scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2004, 2006, 2013 Free Software Foundation, Inc. ;;;; Copyright (C) 2004, 2006, 2013, 2019 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -222,6 +222,12 @@
(cons (join-thread child) out))) (cons (join-thread child) out)))
(throw 'unresolved))))) (throw 'unresolved)))))
(with-test-prefix "basename"
(pass-if-equal "/" "/" (basename "/"))
(pass-if-equal "//" "/" (basename "//"))
(pass-if-equal "a/b/c" "c" (basename "a/b/c")))
(delete-file (test-file)) (delete-file (test-file))
(when (file-exists? (test-symlink)) (when (file-exists? (test-symlink))
(delete-file (test-symlink))) (delete-file (test-symlink)))