From @tonycoz

133951-cwd-unreadable.patch

From 21626e64ef929675e95a44df0662b5d778b5c6e9 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 25 Mar 2019 16:11:16 +1100
Subject: (perl #133951) don't write an invalid lib/buildcustomize.pl

Cwd under miniperl (at this point) can't determine the current
directory if some ancestor directory isn't readable.

So Cwd::getcwd() would return undef, and write_buildcustomize.pl
would write out a list of paths relative to / rather than to the cwd.
---
 write_buildcustomize.pl | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/write_buildcustomize.pl b/write_buildcustomize.pl
index e82f931bae..862b09fab8 100644
--- a/write_buildcustomize.pl
+++ b/write_buildcustomize.pl
@@ -61,6 +61,9 @@ require Cwd;
 
 my $cwd  = Cwd::getcwd();
 
+defined $cwd
+  or die "$0: Can't determine current working directory\n";
+
 # lib must be last, as the toolchain modules write themselves into it
 # as they build, and it's important that @INC order ensures that the partially
 # written files are always masked by the complete versions.
-- 
2.11.0


From 89964055cbd297551d92ba70d7b3fc2b3291296b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 25 Mar 2019 16:48:40 +1100
Subject: (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

diff --git a/MANIFEST b/MANIFEST
index feb56580d1..7e447558e6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5424,6 +5424,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*
-- 
2.11.0


From 70e01a17cce7532b3ce9dc81d976b0fa02fc7529 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 26 Mar 2019 14:23:53 +1100
Subject: (perl #133951) fallback to the built-in getcwd if we can

---
 dist/PathTools/Cwd.pm                     |  6 +++++-
 dist/PathTools/lib/File/Spec.pm           |  2 +-
 dist/PathTools/lib/File/Spec/AmigaOS.pm   |  2 +-
 dist/PathTools/lib/File/Spec/Cygwin.pm    |  2 +-
 dist/PathTools/lib/File/Spec/Epoc.pm      |  2 +-
 dist/PathTools/lib/File/Spec/Functions.pm |  2 +-
 dist/PathTools/lib/File/Spec/Mac.pm       |  2 +-
 dist/PathTools/lib/File/Spec/OS2.pm       |  2 +-
 dist/PathTools/lib/File/Spec/Unix.pm      |  2 +-
 dist/PathTools/lib/File/Spec/VMS.pm       |  2 +-
 dist/PathTools/lib/File/Spec/Win32.pm     |  2 +-
 dist/PathTools/t/cwd.t                    | 11 ++++++++++-
 12 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm
index ff0d01d95a..ec3ad5ab45 100644
--- a/dist/PathTools/Cwd.pm
+++ b/dist/PathTools/Cwd.pm
@@ -3,7 +3,7 @@ use strict;
 use Exporter;
 
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
@@ -659,6 +659,10 @@ if (exists $METHOD_MAP{$^O}) {
   }
 }
 
+# built-in from 5.30
+*getcwd = \&Internals::getcwd
+  if !defined &getcwd && defined &Internals::getcwd;
+
 # In case the XS version doesn't load.
 *abs_path = \&_perl_abs_path unless defined &abs_path;
 *getcwd = \&_perl_getcwd unless defined &getcwd;
diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm
index 3e203173a6..7fe3272721 100644
--- a/dist/PathTools/lib/File/Spec.pm
+++ b/dist/PathTools/lib/File/Spec.pm
@@ -2,7 +2,7 @@ package File::Spec;
 
 use strict;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 my %module = (
diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm
index 51210e69a1..2b7d18a85f 100644
--- a/dist/PathTools/lib/File/Spec/AmigaOS.pm
+++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm
@@ -3,7 +3,7 @@ package File::Spec::AmigaOS;
 use strict;
 require File::Spec::Unix;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm
index de401b613a..d44ced3d63 100644
--- a/dist/PathTools/lib/File/Spec/Cygwin.pm
+++ b/dist/PathTools/lib/File/Spec/Cygwin.pm
@@ -3,7 +3,7 @@ package File::Spec::Cygwin;
 use strict;
 require File::Spec::Unix;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm
index 264bbc83b3..b611cd9f64 100644
--- a/dist/PathTools/lib/File/Spec/Epoc.pm
+++ b/dist/PathTools/lib/File/Spec/Epoc.pm
@@ -2,7 +2,7 @@ package File::Spec::Epoc;
 
 use strict;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 require File::Spec::Unix;
diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm
index 0816bb0c99..3f617bdd36 100644
--- a/dist/PathTools/lib/File/Spec/Functions.pm
+++ b/dist/PathTools/lib/File/Spec/Functions.pm
@@ -3,7 +3,7 @@ package File::Spec::Functions;
 use File::Spec;
 use strict;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 require Exporter;
diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm
index 42406aa7df..d920d2f5db 100644
--- a/dist/PathTools/lib/File/Spec/Mac.pm
+++ b/dist/PathTools/lib/File/Spec/Mac.pm
@@ -4,7 +4,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm
index f91ec60c54..603781aa85 100644
--- a/dist/PathTools/lib/File/Spec/OS2.pm
+++ b/dist/PathTools/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm
index 591846b53e..6749e6047c 100644
--- a/dist/PathTools/lib/File/Spec/Unix.pm
+++ b/dist/PathTools/lib/File/Spec/Unix.pm
@@ -3,7 +3,7 @@ package File::Spec::Unix;
 use strict;
 use Cwd ();
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 =head1 NAME
diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm
index 1e13ac64e7..6c20fb1922 100644
--- a/dist/PathTools/lib/File/Spec/VMS.pm
+++ b/dist/PathTools/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm
index a4ddca80e7..5934010439 100644
--- a/dist/PathTools/lib/File/Spec/Win32.pm
+++ b/dist/PathTools/lib/File/Spec/Win32.pm
@@ -5,7 +5,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.77';
+our $VERSION = '3.78';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/t/cwd.t b/dist/PathTools/t/cwd.t
index 483b4378d5..c05693880e 100644
--- a/dist/PathTools/t/cwd.t
+++ b/dist/PathTools/t/cwd.t
@@ -10,6 +10,7 @@ chdir 't';
 use Config;
 use File::Spec;
 use File::Path;
+use Errno qw(EACCES);
 
 use lib File::Spec->catdir('t', 'lib');
 use Test::More;
@@ -208,7 +209,15 @@ SKIP: {
 
     like($abs_path,      qr|$want$|i, "Cwd::abs_path produced $abs_path");
     like($fast_abs_path, qr|$want$|i, "Cwd::fast_abs_path produced $fast_abs_path");
-    like($pas,           qr|$want$|i, "Cwd::_perl_abs_path produced $pas") if $EXTRA_ABSPATH_TESTS;
+    if ($EXTRA_ABSPATH_TESTS) {
+        # _perl_abs_path() can fail if some ancestor directory isn't readable
+        if (defined $pas) {
+            like($pas,           qr|$want$|i, "Cwd::_perl_abs_path produced $pas");
+        }
+        else {
+            is($!+0, EACCES, "check we got the expected error on failure");
+        }
+    }
 
     rmtree($test_dirs[0], 0, 0);
     1 while unlink $file;
-- 
2.11.0

Uh oh!

5.28+ fails to build: miniperl can't locate strict #16903

Description

Metadata

Metadata

Assignees

Labels

Type

Fields

Projects

Milestone

Relationships

Development

Issue actions