From 15f67d146cf1f32504e8a11de3faa2abc0f467cd Mon Sep 17 00:00:00 2001 From: Tony Cook 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*