diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | t/io/getcwd.t | 22 | ||||
| -rw-r--r-- | universal.c | 22 |
3 files changed, 45 insertions, 0 deletions
@@ -5425,6 +5425,7 @@ t/io/errno.t See if $! is correctly set 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 diff --git a/t/io/getcwd.t b/t/io/getcwd.t new file mode 100644 index 0000000000..f3ad58bb4c --- /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(); diff --git a/universal.c b/universal.c index c1b5dd4b14..66eafc5c3d 100644 --- 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 these_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* |