This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
give Win32 miniperl a real getcwd for build perf
authorDaniel Dragan <bulk88@hotmail.com>
Thu, 10 Dec 2015 23:35:34 +0000 (18:35 -0500)
committerTony Cook <tony@develop-help.com>
Wed, 6 Jan 2016 23:25:16 +0000 (10:25 +1100)
getcwd() is now 605x faster for Win32 miniperl.
------------------------------
use Cwd;
Cwd::getcwd() for(0..10000);
------------------------------
before
C:\p523\src\win32>timeit -f t.dat ..\miniperl -I..\lib t.pl
Version Number:   Windows NT 6.1 (Build 7601)
Exit Time:        2:03 am, Thursday, December 10 2015
Elapsed Time:     0:01:12.438
Process Time:     0:00:14.289
System Calls:     5802378
Context Switches: 1455066
Page Faults:      5250724
Bytes Read:       76809789
Bytes Written:    5278717
Bytes Other:      10407004
after
C:\p523\src\win32>timeit -f t.dat ..\miniperl -I..\lib t.pl
Version Number:   Windows NT 6.1 (Build 7601)
Exit Time:        1:20 am, Thursday, December 10 2015
Elapsed Time:     0:00:00.119
Process Time:     0:00:00.124
System Calls:     4658
Context Switches: 540
Page Faults:      1127
Bytes Read:       99074
Bytes Written:    0
Bytes Other:      12888

15 files changed:
Porting/Maintainers.pl
cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm
dist/PathTools/Cwd.pm
dist/PathTools/lib/File/Spec.pm
dist/PathTools/lib/File/Spec/AmigaOS.pm
dist/PathTools/lib/File/Spec/Cygwin.pm
dist/PathTools/lib/File/Spec/Epoc.pm
dist/PathTools/lib/File/Spec/Functions.pm
dist/PathTools/lib/File/Spec/Mac.pm
dist/PathTools/lib/File/Spec/OS2.pm
dist/PathTools/lib/File/Spec/Unix.pm
dist/PathTools/lib/File/Spec/VMS.pm
dist/PathTools/lib/File/Spec/Win32.pm
t/porting/customized.dat
win32/win32.c

index c33da87..7f455b5 100755 (executable)
@@ -485,6 +485,8 @@ use File::Glob qw(:case);
             qq[t/vstrings.t],
         # Upstreamed as https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker/commit/dd1e236ab
             qq[lib/ExtUtils/MM_VMS.pm],
+        # Not yet submitted
+            qq[t/lib/MakeMaker/Test/NoXS.pm],
         ],
     },
 
index 45faf7e..df36e82 100644 (file)
@@ -10,6 +10,15 @@ require XSLoader;
 # Things like Cwd key on this to decide if they're running miniperl
 delete $DynaLoader::{boot_DynaLoader};
 
+if ($^O eq 'MSWin32') {
+    require Win32;
+    my $GetCwd = *{'Win32::GetCwd'}{CODE};
+    my $SetChildShowWindow = *{'Win32::SetChildShowWindow'}{CODE};
+    %{*main::Win32::{HASH}} = ();
+    *{'Win32::GetCwd'} = $GetCwd;
+    *{'Win32::SetChildShowWindow'} = $SetChildShowWindow;
+}
+
 # This isn't 100%.  Things like Win32.pm will crap out rather than
 # just not load.  See ExtUtils::MM->_is_win95 for an example
 no warnings 'redefine';
index 64618f9..50594ba 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
@@ -628,19 +628,7 @@ sub _win32_cwd_simple {
 
 sub _win32_cwd {
     my $pwd;
-    # Need to avoid taking any sort of reference to the typeglob or the code in
-    # the optree, so that this tests the runtime state of things, as the
-    # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
-    # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
-    # lookup avoids needing a string eval, which has been reported to cause
-    # problems (for reasons that we haven't been able to get to the bottom of -
-    # rt.cpan.org #56225)
-    if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
-       $pwd = Win32::GetCwd();
-    }
-    else { # miniperl
-       chomp($pwd = `cd`);
-    }
+    $pwd = Win32::GetCwd();
     $pwd =~ s:\\:/:g ;
     $ENV{'PWD'} = $pwd;
     return $pwd;
index f416908..bcbec2d 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 my %module = (MacOS   => 'Mac',
index f979f2f..7d02ad5 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index 558a742..9dd176b 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index afca637..0c640ed 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 require File::Spec::Unix;
index 276ddcf..9badcf2 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 
 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 require Exporter;
index 4da700c..06e73c8 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index fad1198..d6d2f48 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index 94e4351..5f92112 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec::Unix;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
index b050bf2..ecb239d 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index 8839800..447cbf5 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.60';
+$VERSION = '3.61';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index 7b15fbd..6733572 100644 (file)
@@ -7,6 +7,7 @@ ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm fd048a43fc
 ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm 0c78ba02d6249dfcca12ac9886a7c7cfb60e77fe
 ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/prereq.t 53bda2c549fd13a6b6c13a070ca6bc79883081c0
 ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/vstrings.t 90035a2bdbf45f15b9c3196d072d7cba7e662871
+ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm 371cdff1b2375017907cfbc9c8f4a31f5ad10582
 Math::BigRat cpan/Math-BigRat/lib/Math/BigRat.pm 6eabc68e04f67694f6fe523e64eb013fc337ca5b
 Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm fe0bc906fb74b69cfd3fb289316ba669d770d465
 Scalar-List-Utils cpan/Scalar-List-Utils/lib/List/Util.pm 62d2a82a811b531a3fd25cb60c4c2ef943858892
index 1f6bd91..b410f66 100644 (file)
@@ -4232,6 +4232,35 @@ XS(w32_SetChildShowWindow)
     XSRETURN(1);
 }
 
+
+#ifdef PERL_IS_MINIPERL
+/* shelling out is much slower, full perl uses Win32.pm */
+XS(w32_GetCwd)
+{
+    dXSARGS;
+    /* Make the host for current directory */
+    char* ptr = PerlEnv_get_childdir();
+    /*
+     * If ptr != Nullch
+     *   then it worked, set PV valid,
+     *   else return 'undef'
+     */
+    if (ptr) {
+       SV *sv = sv_newmortal();
+       sv_setpv(sv, ptr);
+       PerlEnv_free_childdir(ptr);
+
+#ifndef INCOMPLETE_TAINTS
+       SvTAINTED_on(sv);
+#endif
+
+       ST(0) = sv;
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+#endif
+
 void
 Perl_init_os_extras(void)
 {
@@ -4253,6 +4282,9 @@ Perl_init_os_extras(void)
 #endif
 
     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
+#ifdef PERL_IS_MINIPERL
+    newXS("Win32::GetCwd", w32_GetCwd, file);
+#endif
 }
 
 void *