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*