In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2a83af89df68ce54de3e64b6f300ac186c442e8b?hp=45957f2ee9816a6647753f1d918f837b83e9bf04>
- Log ----------------------------------------------------------------- commit 2a83af89df68ce54de3e64b6f300ac186c442e8b Author: Christoph Lamprecht <[email protected]> Date: Mon May 11 14:00:11 2009 -0700 do/require don't treat '.\foo' or '..\foo' as "absolute paths" on Windows. Both 'do' and 'require' treat paths *explicitly* relative to the current directory (starting with './' or '../') as a special form of absolute path. That means they can be loaded directly and don't need to be resolved via @INC, so they don't rely on '.' being in @INC (unless running in taint mode). This behavior is "documented" in the P5P thread "Coderefs in @INC" from 2002. The code is missing special treatment of backslashes on Windows so that '.\\' and '..\\' are handled in the same manner. This change fixes http://rt.perl.org/rt3/Public/Bug/Display.html?id=63492 (Note that the references to taint mode in the bug report are only relevant as far as taint mode removes '.' from @INC). This change also fixes the following Scalar-List-Utils bug report: http://rt.cpan.org/Public/Bug/Display.html?id=25430 The Scalar::Util test failure in t/p_tainted.t only manifests itself under Test::Harness 3, and only outside the Perl core: * Test::Harness 2 (erroneously) puts '-I.' on the commandline in taint mode and runs something like this: `perl -I. t/p_tainted.t` so '.\t\tainted.t' can be found via '.' in @INC. * Core Perl runs something like this from the t/ directory: `..\perl.exe -I../lib ../ext/List-Util/t/p_tainted.t` so '.\..\ext\List-Util\t\tained.t' can be found via '../lib' in @INC. Signed-off-by: Jan Dubois <[email protected]> (cherry-picked from commit 36f064bc37569629cfa8ffed15497f849ae8ccfa, except that I mainly used the pp-ctl.c diff from the original patch rather than what went into bleed, due to the MACOS_TRADITIONAL removal M AUTHORS M pp_ctl.c M t/run/switcht.t commit 8bc56ce9691600903fdd67d962b4923d0eac62fb Author: Ricardo SIGNES <[email protected]> Date: Thu May 14 09:17:18 2009 +0200 document Git_Data (cherry picked from commit 58ab674396867145170e9c1fbd7457883b386ab8) M configpm commit 81a7c5c939c6093950b2bbacf670e0891c10c2b2 Author: Vincent Pit <[email protected]> Date: Thu May 14 09:05:36 2009 +0200 Remove remaining POD tags in verbatim paragraphs (cherry picked from commit ea8b8ad24d31f92547d2469708185eb6d4cf1a13) M pod/perlboot.pod M pod/perlperf.pod M pod/perlport.pod M pod/perlrecharclass.pod M pod/perlunicode.pod commit 08490c46ede2599c0ce3915a8f48e9571f5bbc5c Author: Jan Dubois <[email protected]> Date: Mon May 11 15:21:27 2009 -0700 select() generates "Invalid parameter" messages on Windows Vista. The messages are generated by OutputDebugString() so are only visible inside a debugger, or other debugger viewer applications. The messages are generated by the _get_osfhandle() calls with invalid file ids. This change makes sure it is only called when the corresponding bit in the select() arguments has been set. Related bug reports: http://bugs.activestate.com/show_bug.cgi?id=82995 http://bugs.slimdevices.com/show_bug.cgi?id=11896 http://getpopfile.org/ticket/45 Even with this patch there are still residual "Invalid parameter" messages in the debug output while building Perl itself. They are generated by miniperl in the win32_fclose() function, again calling _get_osfhandle() with an invalid handle. The same messages can be observed when Perl is built *without* USE_PERLIO (just like miniperl). (cherry picked from commit f7bbabd3deb33ca111eb6b17f0252ad07f079f16) M win32/win32sck.c ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + configpm | 15 +++++++++++++ pod/perlboot.pod | 2 +- pod/perlperf.pod | 53 +++++++++++++++++++++++------------------------ pod/perlport.pod | 6 ++-- pod/perlrecharclass.pod | 8 +++--- pod/perlunicode.pod | 2 +- pp_ctl.c | 6 +++++ t/run/switcht.t | 22 ++++++++++++++++++- win32/win32sck.c | 35 +++++++++++++++++++++--------- 10 files changed, 102 insertions(+), 48 deletions(-) diff --git a/AUTHORS b/AUTHORS index d25c432..3e508da 100644 --- a/AUTHORS +++ b/AUTHORS @@ -168,6 +168,7 @@ Chris Pepper Chris Wick <[email protected]> Christian Kirsch <[email protected]> Christian Winter <[email protected]> +Christoph Lamprecht <[email protected]> Christophe Grosjean <[email protected]> Christopher Chan-Nui <[email protected]> Christopher Davis <[email protected]> diff --git a/configpm b/configpm index 7651a9c..5baed2b 100755 --- a/configpm +++ b/configpm @@ -938,6 +938,21 @@ print CONFIG_POD <<'ENDOFTAIL'; =back +=head1 GIT DATA + +Information on the git commit from which the current perl binary was compiled +can be found in the variable C<$Config::Git_Data>. The variable is a +structured string that looks something like this: + + git_commit_id='ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52' + git_describe='GitLive-blead-1076-gea0c2db' + git_branch='smartmatch' + git_uncommitted_changes='' + git_commit_id_title='Commit id:' + git_commit_date='2009-05-09 17:47:31 +0200' + +Its format is not guaranteed not to change over time. + =head1 NOTE This module contains a good example of how to use tie to implement a diff --git a/pod/perlboot.pod b/pod/perlboot.pod index f4327a7..cf8e518 100644 --- a/pod/perlboot.pod +++ b/pod/perlboot.pod @@ -538,7 +538,7 @@ the name: Inside C<Horse::name>, the C<@_> array contains: - (C<$horse>, "some", "unnecessary", "args") + ($horse, "some", "unnecessary", "args") so the C<shift> stores C<$horse> into C<$self>. Then, C<$self> gets de-referenced with C<$$self> as normal, yielding C<"Mr. Ed">. diff --git a/pod/perlperf.pod b/pod/perlperf.pod index 2b189bf..adc1ebb 100644 --- a/pod/perlperf.pod +++ b/pod/perlperf.pod @@ -1117,18 +1117,17 @@ Further reading can be found using the modules and links below. =head2 PERLDOCS -For example: perldoc -f sort +For example: C<perldoc -f sort>. - L<perlfaq4> - L<perlfork> - L<perlfunc> - L<perlretut> - L<perlthrtut> - L<threads> +L<perlfaq4>. + +L<perlfork>, L<perlfunc>, L<perlretut>, L<perlthrtut>. + +L<threads>. =head2 MAN PAGES - L<time> +C<time>. =head2 MODULES @@ -1136,25 +1135,25 @@ It's not possible to individually showcase all the performance related code for Perl here, naturally, but here's a short list of modules from the CPAN which deserve further attention. - L<Apache::DProf> - L<Apache::SmallProf> - L<Benchmark> - L<DBIx::Profiler> - L<Devel::AutoProfiler> - L<Devel::DProf> - L<Devel::DProfLB> - L<Devel::FastProf> - L<Devel::GraphVizProf> - L<Devel::NYTProf> - L<Devel::NYTProf::Apache> - L<Devel::Profiler> - L<Devel::Profile> - L<Devel::Profit> - L<Devel::SmallProf> - L<Devel::WxProf> - L<POE::Devel::Profiler> - L<Sort::Key> - L<Sort::Maker> + Apache::DProf + Apache::SmallProf + Benchmark + DBIx::Profiler + Devel::AutoProfiler + Devel::DProf + Devel::DProfLB + Devel::FastProf + Devel::GraphVizProf + Devel::NYTProf + Devel::NYTProf::Apache + Devel::Profiler + Devel::Profile + Devel::Profit + Devel::SmallProf + Devel::WxProf + POE::Devel::Profiler + Sort::Key + Sort::Maker =head2 URLS diff --git a/pod/perlport.pod b/pod/perlport.pod index 35635a0..1bda8c0 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1248,12 +1248,12 @@ Perl on VOS is discussed in F<README.vos> in the perl distribution (installed as L<perlvos>). Perl on VOS can accept either VOS- or Unix-style file specifications as in either of the following: - C<< $ perl -ne "print if /perl_setup/i" >system>notices >> - C<< $ perl -ne "print if /perl_setup/i" /system/notices >> + $ perl -ne "print if /perl_setup/i" >system>notices + $ perl -ne "print if /perl_setup/i" /system/notices or even a mixture of both as in: - C<< $ perl -ne "print if /perl_setup/i" >system/notices >> + $ perl -ne "print if /perl_setup/i" >system/notices Even though VOS allows the slash character to appear in object names, because the VOS port of Perl interprets it as a pathname diff --git a/pod/perlrecharclass.pod b/pod/perlrecharclass.pod index c86a2c3..a626dd9 100644 --- a/pod/perlrecharclass.pod +++ b/pod/perlrecharclass.pod @@ -387,16 +387,16 @@ Perl recognizes the following POSIX character classes: alpha Any alphabetical character. alnum Any alphanumerical character. ascii Any ASCII character. - blank A GNU extension, equal to a space or a horizontal tab (C<\t>). + blank A GNU extension, equal to a space or a horizontal tab ("\t"). cntrl Any control character. - digit Any digit, equivalent to C<\d>. + digit Any digit, equivalent to "\d". graph Any printable character, excluding a space. lower Any lowercase character. print Any printable character, including a space. punct Any punctuation character. - space Any white space character. C<\s> plus the vertical tab (C<\cK>). + space Any white space character. "\s" plus the vertical tab ("\cK"). upper Any uppercase character. - word Any "word" character, equivalent to C<\w>. + word Any "word" character, equivalent to "\w". xdigit Any hexadecimal digit, '0' - '9', 'a' - 'f', 'A' - 'F'. The exact set of characters matched depends on whether the source string diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index 3a52933..5dbd3cd 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -941,7 +941,7 @@ Level 1 - Basic Unicode Support Alphabetic, Lowercase, Uppercase, WhiteSpace, NoncharacterCodePoint, DefaultIgnorableCodePoint, Any, ASCII, Assigned), but also bidirectional types, blocks, etc. - (see L</"Unicode Character Properties">) + (see "Unicode Character Properties") [4] \d \D \s \S \w \W \X [:prop:] [:^prop:] [5] can use regular expression look-ahead [a] or user-defined character properties [b] to emulate set operations diff --git a/pp_ctl.c b/pp_ctl.c index c858277..aef521f 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4878,6 +4878,12 @@ S_path_is_absolute(const char *name) if (PERL_FILE_IS_ABSOLUTE(name) #ifdef MACOS_TRADITIONAL || (*name == ':') +#ifdef WIN32 + || (*name == '.' && ((name[1] == '/' || + (name[1] == '.' && name[2] == '/')) + || (name[1] == '\\' || + ( name[1] == '.' && name[2] == '\\'))) + ) #else || (*name == '.' && (name[1] == '/' || (name[1] == '.' && name[2] == '/'))) diff --git a/t/run/switcht.t b/t/run/switcht.t index 564b2f3..6f0fed5 100644 --- a/t/run/switcht.t +++ b/t/run/switcht.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 11; +plan tests => 13; my $Perl = which_perl(); @@ -44,3 +44,23 @@ like( $warning, qr/^Insecure dependency in unlink $Tmsg/, ok( !-e $file, 'unlink worked' ); ok( !$^W, "-t doesn't enable regular warnings" ); + + +mkdir('tt'); +open(FH,'>','tt/ttest.pl')or DIE $!; +print FH 'return 42'; +close FH or DIE $!; + +SKIP: { + ($^O eq 'MSWin32') || skip('skip tainted do test with \ seperator'); + my $test = 0; + $test = do '.\tt/ttest.pl'; + is($test, 42, 'Could "do" .\tt/ttest.pl'); +} +{ + my $test = 0; + $test = do './tt/ttest.pl'; + is($test, 42, 'Could "do" ./tt/ttest.pl'); +} +unlink ('./tt/ttest.pl'); +rmdir ('tt'); diff --git a/win32/win32sck.c b/win32/win32sck.c index 2427cb3..7798168 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -279,13 +279,18 @@ win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const FD_ZERO(&nwr); FD_ZERO(&nex); for (i = 0; i < nfds; i++) { - fd = TO_SOCKET(i); - if (rd && PERL_FD_ISSET(i,rd)) + if (rd && PERL_FD_ISSET(i,rd)) { + fd = TO_SOCKET(i); FD_SET((unsigned)fd, &nrd); - if (wr && PERL_FD_ISSET(i,wr)) + } + if (wr && PERL_FD_ISSET(i,wr)) { + fd = TO_SOCKET(i); FD_SET((unsigned)fd, &nwr); - if (ex && PERL_FD_ISSET(i,ex)) + } + if (ex && PERL_FD_ISSET(i,ex)) { + fd = TO_SOCKET(i); FD_SET((unsigned)fd, &nex); + } } errno = save_errno; @@ -293,13 +298,21 @@ win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const save_errno = errno; for (i = 0; i < nfds; i++) { - fd = TO_SOCKET(i); - if (rd && PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd)) - PERL_FD_CLR(i,rd); - if (wr && PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr)) - PERL_FD_CLR(i,wr); - if (ex && PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex)) - PERL_FD_CLR(i,ex); + if (rd && PERL_FD_ISSET(i,rd)) { + fd = TO_SOCKET(i); + if (!FD_ISSET(fd, &nrd)) + PERL_FD_CLR(i,rd); + } + if (wr && PERL_FD_ISSET(i,wr)) { + fd = TO_SOCKET(i); + if (!FD_ISSET(fd, &nwr)) + PERL_FD_CLR(i,wr); + } + if (ex && PERL_FD_ISSET(i,ex)) { + fd = TO_SOCKET(i); + if (!FD_ISSET(fd, &nex)) + PERL_FD_CLR(i,ex); + } } errno = save_errno; #else -- Perl5 Master Repository
