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*
|