|
|
- From 15f67d146cf1f32504e8a11de3faa2abc0f467cd Mon Sep 17 00:00:00 2001
- From: Tony Cook <tony@develop-help.com>
- Date: Mon, 25 Mar 2019 16:48:40 +1100
- Subject: [PATCH] (perl #133951) add Internals::getcwd
-
- ---
- MANIFEST | 1 +
- t/io/getcwd.t | 22 ++++++++++++++++++++++
- universal.c | 22 ++++++++++++++++++++++
- 3 files changed, 45 insertions(+)
- create mode 100644 t/io/getcwd.t
-
- --- a/MANIFEST
- +++ b/MANIFEST
- @@ -5456,6 +5456,7 @@ t/io/errno.t See if $! is correctly se
- t/io/errnosig.t Test case for restoration $! when leaving signal handlers
- t/io/fflush.t See if auto-flush on fork/exec/system/qx works
- t/io/fs.t See if directory manipulations work
- +t/io/getcwd.t See if Internals::getcwd is sane
- t/io/inplace.t See if inplace editing works
- t/io/iofile.t See if we can load IO::File on demand
- t/io/iprefix.t See if inplace editing works with prefixes
- --- /dev/null
- +++ b/t/io/getcwd.t
- @@ -0,0 +1,22 @@
- +#!./perl -w
- +
- +BEGIN {
- + chdir 't' if -d 't';
- + require "./test.pl";
- + set_up_inc('../lib');
- +}
- +
- +use Config;
- +
- +$Config{d_getcwd}
- + or plan skip_all => "no getcwd";
- +
- +my $cwd = Internals::getcwd();
- +ok(!defined $cwd || $cwd ne "",
- + "Internals::getcwd() returned a reasonable result");
- +
- +if (defined $cwd) {
- + ok(-d $cwd, "check a success result is a directory");
- +}
- +
- +done_testing();
- --- a/universal.c
- +++ b/universal.c
- @@ -986,6 +986,25 @@ XS(XS_re_regexp_pattern)
- NOT_REACHED; /* NOTREACHED */
- }
-
- +#ifdef HAS_GETCWD
- +
- +XS(XS_Internals_getcwd)
- +{
- + dXSARGS;
- + SV *sv = sv_newmortal();
- +
- + if (items != 0)
- + croak_xs_usage(cv, "");
- +
- + (void)getcwd_sv(sv);
- +
- + SvTAINTED_on(sv);
- + PUSHs(sv);
- + XSRETURN(1);
- +}
- +
- +#endif
- +
- #include "vutil.h"
- #include "vxs.inc"
-
- @@ -1020,6 +1039,9 @@ static const struct xsub_details details
- {"re::regnames", XS_re_regnames, ";$"},
- {"re::regnames_count", XS_re_regnames_count, ""},
- {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
- +#ifdef HAS_GETCWD
- + {"Internals::getcwd", XS_Internals_getcwd, ""},
- +#endif
- };
-
- STATIC OP*
|
