[perl.git] branch maint-5.10, updated. GitLive-maint-5.10-1160-g2a83af8

David Mitchell

2009-05-14 13:14:59 UTC

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 <***@online.de>
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 <***@activestate.com>

(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 <***@cpan.org>
Date: Thu May 14 09:17:18 2009 +0200

document Git_Data

(cherry picked from commit 58ab674396867145170e9c1fbd7457883b386ab8)

M configpm

commit 81a7c5c939c6093950b2bbacf670e0891c10c2b2
Author: Vincent Pit <***@profvince.com>
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 <***@activestate.com>
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 <***@lmc.com>
Christian Kirsch <***@held.mind.de>
Christian Winter <***@linux-config.de>
+Christoph Lamprecht <***@online.de>
Christophe Grosjean <***@gmail.com>
Christopher Chan-Nui <***@austin.ibm.com>
Christopher Davis <***@loiosh.kei.com>
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