'basename' correctly handles "/" and "//".
authorLudovic Courtès <ludo@gnu.org>
Tue, 4 Jun 2019 19:20:15 +0000 (21:20 +0200)
committerLudovic Courtès <ludo@gnu.org>
Tue, 4 Jun 2019 19:24:02 +0000 (21:24 +0200)
* libguile/filesys.c (scm_basename): Special-case "/" and "//".
* test-suite/tests/filesys.test ("basename"): New test prefix.

libguile/filesys.c
test-suite/tests/filesys.test

index 1a8dfa04423c99d2bab23b30bfc3e51720d24b90..3cf474c05ea0d8702020be9d05745fe00e418624 100644 (file)
@@ -1602,11 +1602,20 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
   c_filename = scm_to_utf8_string (filename);
   scm_dynwind_free (c_filename);
 
-  c_last_component = last_component (c_filename);
-  if (!c_last_component)
-    res = filename;
+  if (strcmp (c_filename, "/") == 0
+      || strcmp (c_filename, "//") == 0)
+    /* As per
+       <http://pubs.opengroup.org/onlinepubs/9699919799/functions/basename.html>,
+       "/" and "//" are treated specially.  */
+    res = scm_from_utf8_string ("/");
   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 ();
 
   if (!SCM_UNBNDP (suffix) &&
index fceb182be3935b31d9508c2a164fbd7f3e302f1a..9ec9f6172e8d2ba2906e8734c37d0873127c1fa4 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; 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
 ;;;; modify it under the terms of the GNU Lesser General Public
               (cons (join-thread child) out)))
           (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))
 (when (file-exists? (test-symlink))
   (delete-file (test-symlink)))