mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
basename: check suffix against basename, not full argument
* libguile/filesys: check suffix against basename, not full argument. Closes: 69437
This commit is contained in:
parent
9a57c237d2
commit
c03115c39d
3 changed files with 34 additions and 13 deletions
2
NEWS
2
NEWS
|
@ -15,6 +15,8 @@ Changes in 3.0.11 (since 3.0.10)
|
||||||
|
|
||||||
* Bug fixes
|
* Bug fixes
|
||||||
|
|
||||||
|
** `basename` now checks the suffix against the base name, not the full path
|
||||||
|
(<https://debbugs.gnu.org/69437>)
|
||||||
** test-hashing should now work on 32-bit systems
|
** test-hashing should now work on 32-bit systems
|
||||||
** GUILE-VERSION changes should propagate to .version and relevant Makefiles
|
** GUILE-VERSION changes should propagate to .version and relevant Makefiles
|
||||||
(<https://debbugs.gnu.org/72084>)
|
(<https://debbugs.gnu.org/72084>)
|
||||||
|
|
|
@ -2037,10 +2037,10 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
|
||||||
|
|
||||||
SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
|
SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
|
||||||
(SCM filename, SCM suffix),
|
(SCM filename, SCM suffix),
|
||||||
"Return the base name of the file name @var{filename}. The\n"
|
"Return the base name of @var{filename}. The base name is the\n"
|
||||||
"base name is the file name without any directory components.\n"
|
"@var{filename} without any directory components.\n"
|
||||||
"If @var{suffix} is provided, and is equal to the end of\n"
|
"If the @var{suffix} matches the end of the base name and is\n"
|
||||||
"@var{filename}, it is removed also.")
|
"shorter, then it is removed from the result.\n")
|
||||||
#define FUNC_NAME s_scm_basename
|
#define FUNC_NAME s_scm_basename
|
||||||
{
|
{
|
||||||
char *c_filename;
|
char *c_filename;
|
||||||
|
@ -2057,17 +2057,28 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
|
||||||
"/" and "//" are treated specially. */
|
"/" and "//" are treated specially. */
|
||||||
res = scm_from_utf8_string ("/");
|
res = scm_from_utf8_string ("/");
|
||||||
else
|
else
|
||||||
res = scm_from_utf8_string (last_component (c_filename));
|
{
|
||||||
|
char *last = last_component (c_filename);
|
||||||
|
if (SCM_UNBNDP (suffix))
|
||||||
|
res = scm_from_utf8_string (last);
|
||||||
|
else
|
||||||
|
{
|
||||||
|
char * const c_suffix = scm_to_utf8_string (suffix);
|
||||||
|
scm_dynwind_free (c_suffix);
|
||||||
|
const size_t res_n = strlen (last);
|
||||||
|
const size_t suf_n = strlen (c_suffix);
|
||||||
|
if (suf_n < res_n)
|
||||||
|
{
|
||||||
|
const size_t prefix_n = res_n - suf_n;
|
||||||
|
if (strcmp (last + prefix_n, c_suffix) == 0)
|
||||||
|
last[prefix_n] = '\0';
|
||||||
|
}
|
||||||
|
res = scm_from_utf8_string (last);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
scm_dynwind_end ();
|
scm_dynwind_end ();
|
||||||
|
|
||||||
if (!SCM_UNBNDP (suffix) &&
|
|
||||||
scm_is_true (scm_string_suffix_p (suffix, filename,
|
|
||||||
SCM_UNDEFINED, SCM_UNDEFINED,
|
|
||||||
SCM_UNDEFINED, SCM_UNDEFINED)))
|
|
||||||
res = scm_c_substring
|
|
||||||
(res, 0, scm_c_string_length (res) - scm_c_string_length (suffix));
|
|
||||||
|
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
|
@ -311,7 +311,15 @@
|
||||||
|
|
||||||
(pass-if-equal "/" "/" (basename "/"))
|
(pass-if-equal "/" "/" (basename "/"))
|
||||||
(pass-if-equal "//" "/" (basename "//"))
|
(pass-if-equal "//" "/" (basename "//"))
|
||||||
(pass-if-equal "a/b/c" "c" (basename "a/b/c")))
|
(pass-if-equal "a/b/c" "c" (basename "a/b/c"))
|
||||||
|
|
||||||
|
(pass-if-equal "a.b" (basename "a.b" "a.b"))
|
||||||
|
(pass-if-equal "a.b" (basename "/a.b" "a.b"))
|
||||||
|
(pass-if-equal "a" (basename "a.b" ".b"))
|
||||||
|
(pass-if-equal "a" (basename "/a.b" ".b"))
|
||||||
|
|
||||||
|
;; https://debbugs.gnu.org/69437
|
||||||
|
(pass-if-equal "bar" (basename "foo/bar" "o/bar")))
|
||||||
|
|
||||||
(delete-file (test-file))
|
(delete-file (test-file))
|
||||||
(when (file-exists? (test-symlink))
|
(when (file-exists? (test-symlink))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue