[PATCH] give Win32 miniperl a real getcwd for build perf #15087

p5pRT · 2015-12-10T23:38:50Z

Migrated from rt.perl.org#126877 (status was 'resolved')

Searchable as RT126877$

p5pRT · 2015-12-10T23:38:50Z

From @bulk88

Created by @bulk88

See attached patch. This patch is to improve CI build speed for perl.

7.2 ms per old getcwd call is on a 2.3ghz Core 2 Duo, Win 7 32 bits with
SSD. 11 us is the new getcwd time for miniperl. That is an amazing
improvement, if only I could do such speeds ups every day.

Perl Info


Flags:
        category=core
        severity=low

Site configuration information for perl 5.23.5:

Configured by Owner at Sun Oct 25 19:14:27 2015.

Summary of my perl5 (revision 5 version 23 subversion 5) configuration:
      Derived from: 644207b7a8ff7a2b1661c05a7f9ac2df9a5dad91
      Platform:
        osname=MSWin32, osvers=6.1, archname=MSWin32-x86-multi-thread
        uname=''
        config_args='undef'
        hint=recommended, useposix=true, d_sigaction=undef
        useithreads=define, usemultiplicity=define
        use64bitint=undef, use64bitall=undef, uselongdouble=undef
        usemymalloc=n, bincompat5005=undef
      Compiler:
        cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -GL 
-DWIN32 -D_CONSOLE -DNO_STRICT -D_CRT_SECURE_NO_DEPRECATE 
-D_CRT_NONSTDC_NO_DEPRECATE  -DPERL_TEXTMODE_SCRIPTS 
-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS',
        optimize='-O1 -MD -Zi -DNDEBUG -GL',
        cppflags='-DWIN32'
        ccversion='18.00.31101', gccversion='', gccosandvers=''
        intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, 
doublekind=3
        d_longlong=undef, longlongsize=8, d_longdbl=define, 
longdblsize=8, longdblkind=0
        ivtype='long', ivsize=4, nvtype='double', nvsize=8, 
Off_t='__int64', lseeksize=8
        alignbytes=8, prototype=define
      Linker and Libraries:
        ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf 
-ltcg         -libpath:"c:\p523\lib\CORE"         -machine:x86 
"/manifestdependency:type='Win32' 
name='Microsoft.Windows.Common-Controls' version='6.0.0.0' 
processorArchitecture='*' publicKeyToken='6595b64144ccf1df' 
language='*'" -subsystem:console,"5.01"'
        libpth=\lib
        libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib 
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib 
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib 
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
        perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib 
winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib 
oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib 
version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
        libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl523.lib
        gnulibc_version=''
      Dynamic Linking:
        dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
        cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug 
-opt:ref,icf -ltcg         -libpath:"c:\p523\lib\CORE"  -machine:x86 
"/manifestdependency:type='Win32' 
name='Microsoft.Windows.Common-Controls' version='6.0.0.0' 
processorArchitecture='*' publicKeyToken='6595b64144ccf1df' 
language='*'" -subsystem:console,"5.01"'

Locally applied patches:
        uncommitted-changes


@INC for perl 5.23.5:
        C:/p523/site/lib
        C:/p523/lib
        .


Environment for perl 5.23.5:
        HOME (unset)
        LANG (unset)
        LANGUAGE (unset)
        LD_LIBRARY_PATH (unset)
        LOGDIR (unset)
        PATH=C:\p523\site\bin;C:\p523\bin;C:\Program Files\ActiveState 
Komodo Edit 
9\;C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program 
Files\TortoiseGit\bin;C:\Program Files\Microsoft Windows Performance 
Toolkit\;C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin;C:\Program 
Files\Windows Kits\8.1\Windows Performance Toolkit\;C:\Program 
Files\Microsoft SQL Server\110\Tools\Binn\;C:\Program Files\Microsoft 
SDKs\TypeScript\1.0\;C:\Program Files\TortoiseHg\;
        PERL_BADLANG (unset)
        SHELL (unset)

p5pRT · 2015-12-10T23:38:50Z

From @bulk88

0001-give-Win32-miniperl-a-real-getcwd-for-build-perf.patch

From e871160f42ac868768134e1f539f4c2406c18308 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 10 Dec 2015 18:35:34 -0500
Subject: [PATCH] give Win32 miniperl a real getcwd for build perf

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
---
 Porting/Maintainers.pl                             |  2 ++
 .../t/lib/MakeMaker/Test/NoXS.pm                   |  9 ++++++
 dist/PathTools/Cwd.pm                              | 16 ++---------
 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 +-
 t/porting/customized.dat                           |  1 +
 win32/win32.c                                      | 32 ++++++++++++++++++++++
 15 files changed, 56 insertions(+), 24 deletions(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index b3e8990..e032604 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -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],
         ],
     },
 
diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm
index 45faf7e..df36e82 100644
--- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm
+++ b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm
@@ -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';
diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm
index 39c841d..a9682c3 100644
--- a/dist/PathTools/Cwd.pm
+++ b/dist/PathTools/Cwd.pm
@@ -3,7 +3,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//;
 
@@ -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;
diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm
index 7ee0edb..b1ce3df 100644
--- a/dist/PathTools/lib/File/Spec.pm
+++ b/dist/PathTools/lib/File/Spec.pm
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 my %module = (MacOS   => 'Mac',
diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm
index b65c4a4..05806d5 100644
--- a/dist/PathTools/lib/File/Spec/AmigaOS.pm
+++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm
index 3fd74a4..5817a82 100644
--- a/dist/PathTools/lib/File/Spec/Cygwin.pm
+++ b/dist/PathTools/lib/File/Spec/Cygwin.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm
index bfae600..5a42e05 100644
--- a/dist/PathTools/lib/File/Spec/Epoc.pm
+++ b/dist/PathTools/lib/File/Spec/Epoc.pm
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 require File::Spec::Unix;
diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm
index 5b28a5d..05f7f78 100644
--- a/dist/PathTools/lib/File/Spec/Functions.pm
+++ b/dist/PathTools/lib/File/Spec/Functions.pm
@@ -5,7 +5,7 @@ use strict;
 
 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 require Exporter;
diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm
index 9853df4..358cf57 100644
--- a/dist/PathTools/lib/File/Spec/Mac.pm
+++ b/dist/PathTools/lib/File/Spec/Mac.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm
index ff81d83..3029cc4 100644
--- a/dist/PathTools/lib/File/Spec/OS2.pm
+++ b/dist/PathTools/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm
index 11d99c7..58b00c4 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 vars qw($VERSION);
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//;
 
diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm
index a3b9c47..5936c63 100644
--- a/dist/PathTools/lib/File/Spec/VMS.pm
+++ b/dist/PathTools/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm
index eabf625..6544c0b 100644
--- a/dist/PathTools/lib/File/Spec/Win32.pm
+++ b/dist/PathTools/lib/File/Spec/Win32.pm
@@ -5,7 +5,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/t/porting/customized.dat b/t/porting/customized.dat
index f64c73a..c3038ad 100644
--- a/t/porting/customized.dat
+++ b/t/porting/customized.dat
@@ -6,6 +6,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 682352dde33638125ce12ca44990bd1cd44af4f8
 Module::Metadata cpan/Module-Metadata/t/lib/GeneratePackage.pm 502ffbe2609947430e6aa1a3df8064b3fef3e086
 Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm dcd53fba13060dbb71b1b5861fbc5c0881c8625a
diff --git a/win32/win32.c b/win32/win32.c
index 1f6bd91..b410f66 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -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 *
-- 
1.9.5.msysgit.1

p5pRT · 2016-01-04T03:03:30Z

From @bulk88

On Thu Dec 10 15:38:50 2015, bulk88 wrote:

This is a bug report for perl from bulk88@hotmail.com,
generated with the help of perlbug 1.40 running under perl 5.23.5.

-----------------------------------------------------------------
[Please describe your issue here]

See attached patch. This patch is to improve CI build speed for perl.

7.2 ms per old getcwd call is on a 2.3ghz Core 2 Duo, Win 7 32 bits
with
SSD. 11 us is the new getcwd time for miniperl. That is an amazing
improvement, if only I could do such speeds ups every day.

bump

--
bulk88 ~ bulk88 at hotmail.com

p5pRT · 2016-01-06T23:36:58Z

From @tonycoz

On Thu Dec 10 15:38:50 2015, bulk88 wrote:

See attached patch. This patch is to improve CI build speed for perl.

7.2 ms per old getcwd call is on a 2.3ghz Core 2 Duo, Win 7 32 bits
with
SSD. 11 us is the new getcwd time for miniperl. That is an amazing
improvement, if only I could do such speeds ups every day.

Thanks, applied as 8f1332e.

Tony

p5pRT · 2016-01-06T23:36:58Z

The RT System itself - Status changed from 'new' to 'open'

p5pRT · 2016-01-06T23:36:59Z

@tonycoz - Status changed from 'open' to 'pending release'

p5pRT · 2016-05-13T04:04:16Z

From @khwilliamson

Thank you for submitting this report. You have helped make Perl better.

With the release of Perl 5.24.0 on May 9, 2016, this and 149 other issues have been resolved.

Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0

p5pRT · 2016-05-13T04:04:17Z

@khwilliamson - Status changed from 'pending release' to 'resolved'

p5pRT closed this as completed May 13, 2016

p5pRT added Severity Low distro-mswin32 type-core labels Oct 19, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

[PATCH] give Win32 miniperl a real getcwd for build perf #15087

[PATCH] give Win32 miniperl a real getcwd for build perf #15087

p5pRT commented Dec 10, 2015

p5pRT commented Dec 10, 2015

p5pRT commented Dec 10, 2015

p5pRT commented Jan 4, 2016

p5pRT commented Jan 6, 2016

p5pRT commented Jan 6, 2016

p5pRT commented Jan 6, 2016

p5pRT commented May 13, 2016

p5pRT commented May 13, 2016

[PATCH] give Win32 miniperl a real getcwd for build perf #15087

[PATCH] give Win32 miniperl a real getcwd for build perf #15087

Comments

p5pRT commented Dec 10, 2015

p5pRT commented Dec 10, 2015

From @bulk88

Created by @bulk88

p5pRT commented Dec 10, 2015

From @bulk88

p5pRT commented Jan 4, 2016

From @bulk88

p5pRT commented Jan 6, 2016

From @tonycoz

p5pRT commented Jan 6, 2016

p5pRT commented Jan 6, 2016

p5pRT commented May 13, 2016

From @khwilliamson

p5pRT commented May 13, 2016