In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d68244d37fda468019b0b175f1dec27eced69e70?hp=5f927b37a8cd934ccc549eaeb26899d69aede723>
- Log ----------------------------------------------------------------- commit d68244d37fda468019b0b175f1dec27eced69e70 Author: David Mitchell <[email protected]> Date: Wed Aug 12 01:01:34 2009 +0100 ameliorate B::Deparse slowdown commit 2990415a45 improved the ability to deparse inlined constants, but at the cost of having to walk all the symbol tables when each new B::Deparse object is created. Make this scan instead only happen the first time its needed. (cherry picked from commit 805b10112885d8868f21f8e860792d65e1e6c19d) M ext/B/B/Deparse.pm commit 63483f2a949379b2a19490899b5e3706717f192d Author: Jan Dubois <[email protected]> Date: Tue Aug 11 16:30:32 2009 -0700 On Windows normalize $^X using GetLongPathName() If perl.exe is called with a short pathname, then GetModuleFileName() will return this short name, and $^X will be set to it. This in turn is used to initialize @INC to privlib, sitelib and vendorlib locations relative to $^X, so they too will end up with the mangled short names. Perl will also automatically add versioned Perl directories in the same tree if their names start with the same major and minor Perl version numbers. This heuristic can be broken when the pathname components are using short pathnames. Therefore $^X and @INC should all be normalized to use the long pathname format. See also http://rt.cpan.org/Public/Bug/Display.html?id=47890 (cherry picked from commit ad2561310d3fa13cf664e8d8b8bb294a23cf9ea4) M win32/win32.c ----------------------------------------------------------------------- Summary of changes: ext/B/B/Deparse.pm | 13 +++++++++---- win32/win32.c | 12 ++++++++++++ 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 9ba2442..5685d09 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -570,7 +570,6 @@ sub new { $self->{'ambient_warnings'} = undef; # Assume no lexical warnings $self->{'ambient_hints'} = 0; $self->{'ambient_hinthash'} = undef; - $self->{'inlined_constants'} = $self->scan_for_constants; $self->init(); while (my $arg = shift @_) { @@ -3655,10 +3654,16 @@ sub const { if (class($sv) eq "SPECIAL") { # sv_undef, sv_yes, sv_no return ('undef', '1', $self->maybe_parens("!1", $cx, 21))[$$sv-1]; - } elsif (class($sv) eq "NULL") { + } + if (class($sv) eq "NULL") { return 'undef'; - } elsif ($cx and my $const = $self->{'inlined_constants'}->{ 0 + $sv->object_2svref }) { - return $const; + } + if ($cx) { + unless ($self->{'inlined_constants'}) { + $self->{'inlined_constants'} = $self->scan_for_constants; + } + my $const = $self->{'inlined_constants'}->{ 0 + $sv->object_2svref }; + return $const if $const; } # convert a version object into the "v1.2.3" string in its V magic if ($sv->FLAGS & SVs_RMG) { diff --git a/win32/win32.c b/win32/win32.c index 9cc5361..748e113 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -225,12 +225,24 @@ set_w32_module_name(void) WCHAR fullname[MAX_PATH]; char *ansi; + DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) = + (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD)) + GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW"); + GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR)); /* Make sure we get an absolute pathname in case the module was loaded * explicitly by LoadLibrary() with a relative path. */ GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL); + /* Make sure we start with the long path name of the module because we + * later scan for pathname components to match "5.xx" to locate + * compatible sitelib directories, and the short pathname might mangle + * this path segment (e.g. by removing the dot on NTFS to something + * like "5xx~1.yy") */ + if (pfnGetLongPathNameW) + pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR)); + /* remove \\?\ prefix */ if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0) memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR)); -- Perl5 Master Repository
