Change 20677 by [EMAIL PROTECTED] on 2003/08/13 13:10:04
Integrate:
[ 20668]
perlipc thinko by John P. Linderman.
[ 20669]
More don't:s for nyetworking.
[ 20670]
Subject: [PATCH Tie::File] turn the alarm off in the tests (was Re: maint @
20617 (on VMS))
From: "Craig A. Berry" <[EMAIL PROTECTED]>
Date: Tue, 12 Aug 2003 21:12:00 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 20671]
Subject: [PATCH] another VMS pod nit
From: "Craig A. Berry" <[EMAIL PROTECTED]>
Date: Wed, 13 Aug 2003 01:01:46 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 20672]
One tweak for microperl in OS/2.
[ 20673]
One tweak from Dave Mitchell.
[ 20674]
Make (hopefully) the Windows CR CR LF bug go away
by making the CRLF layer repel any other CRLF layers.
In other words: binmode(FH, ":crlf") in e.g. Win32
is effectively a no-op since there already is one
CRLF layer in the stack by default.
[ 20675]
Bye bye, bug.
[ 20676]
Make Johan's confusion go away, but there are no doubt more
similar cases.
Affected files ...
... //depot/maint-5.8/perl/lib/File/Find.pm#8 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/24_cache_loop.t#2 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/29_downcopy.t#3 integrate
... //depot/maint-5.8/perl/lib/Tie/File/t/29a_upcopy.t#2 integrate
... //depot/maint-5.8/perl/perl.h#49 integrate
... //depot/maint-5.8/perl/perlio.c#30 integrate
... //depot/maint-5.8/perl/pod/perlipc.pod#10 integrate
... //depot/maint-5.8/perl/pod/perlport.pod#12 integrate
... //depot/maint-5.8/perl/pod/perlrun.pod#28 integrate
... //depot/maint-5.8/perl/t/io/crlf.t#6 integrate
... //depot/maint-5.8/perl/t/io/layers.t#9 integrate
... //depot/maint-5.8/perl/vms/descrip_mms.template#13 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/File/Find.pm#8 (text) ====
Index: perl/lib/File/Find.pm
--- perl/lib/File/Find.pm#7~20290~ Tue Jul 29 01:55:19 2003
+++ perl/lib/File/Find.pm Wed Aug 13 06:10:04 2003
@@ -3,7 +3,7 @@
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.04';
+our $VERSION = '1.05';
require Exporter;
require Cwd;
==== //depot/maint-5.8/perl/lib/Tie/File/t/24_cache_loop.t#2 (text) ====
Index: perl/lib/Tie/File/t/24_cache_loop.t
--- perl/lib/Tie/File/t/24_cache_loop.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Tie/File/t/24_cache_loop.t Wed Aug 13 06:10:04 2003
@@ -43,6 +43,7 @@
alarm 5 unless $^P;
@a = "record0" .. "record9";
print "ok 3\n";
+alarm 0;
END {
undef $o;
==== //depot/maint-5.8/perl/lib/Tie/File/t/29_downcopy.t#3 (text) ====
Index: perl/lib/Tie/File/t/29_downcopy.t
--- perl/lib/Tie/File/t/29_downcopy.t#2~19817~ Wed Jun 18 22:24:45 2003
+++ perl/lib/Tie/File/t/29_downcopy.t Wed Aug 13 06:10:04 2003
@@ -273,7 +273,7 @@
local $SIG{ALRM} = sub { die "Alarm clock" };
my $a_retval = eval { alarm(5) unless $^P; $o->_downcopy($newdata, $pos, $len) };
my $err = $@;
- undef $o; untie @lines;
+ undef $o; untie @lines; alarm(0);
if ($err) {
if ($err =~ /^Alarm clock/) {
print "# Timeout\n";
==== //depot/maint-5.8/perl/lib/Tie/File/t/29a_upcopy.t#2 (text) ====
Index: perl/lib/Tie/File/t/29a_upcopy.t
--- perl/lib/Tie/File/t/29a_upcopy.t#1~19515~ Tue May 13 10:51:05 2003
+++ perl/lib/Tie/File/t/29a_upcopy.t Wed Aug 13 06:10:04 2003
@@ -129,7 +129,7 @@
local $SIG{ALRM} = sub { die "Alarm clock" };
my $a_retval = eval { alarm(5) unless $^P; $o->_upcopy($src, $dst, $len) };
my $err = $@;
- undef $o; untie @lines;
+ undef $o; untie @lines; alarm(0);
if ($err) {
if ($err =~ /^Alarm clock/) {
print "# Timeout\n";
==== //depot/maint-5.8/perl/perl.h#49 (text) ====
Index: perl/perl.h
--- perl/perl.h#48~20649~ Tue Aug 12 05:14:31 2003
+++ perl/perl.h Wed Aug 13 06:10:04 2003
@@ -297,7 +297,7 @@
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) ||
defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) ||
defined(PERL_MICRO)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) ||
defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) ||
defined(PERL_MICRO)
# define DONT_DECLARE_STD 1
#endif
==== //depot/maint-5.8/perl/perlio.c#30 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#29~20504~ Tue Aug 5 09:12:30 2003
+++ perl/perlio.c Wed Aug 13 06:10:04 2003
@@ -4038,6 +4038,23 @@
f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
PerlIOBase(f)->flags);
#endif
+ {
+ /* Enable the first CRLF capable layer you can find, but if none
+ * found, the one we just pushed is fine. This results in at
+ * any given moment at most one CRLF-capable layer being enabled
+ * in the whole layer stack. */
+ PerlIO *g = PerlIONext(f);
+ while (g && *g) {
+ PerlIOl *b = PerlIOBase(g);
+ if (b && b->tab == &PerlIO_crlf) {
+ if (!(b->flags & PERLIO_F_CRLF))
+ b->flags |= PERLIO_F_CRLF;
+ PerlIO_pop(aTHX_ f);
+ return code;
+ }
+ g = PerlIONext(g);
+ }
+ }
return code;
}
==== //depot/maint-5.8/perl/pod/perlipc.pod#10 (text) ====
Index: perl/pod/perlipc.pod
--- perl/pod/perlipc.pod#9~20610~ Sun Aug 10 23:37:13 2003
+++ perl/pod/perlipc.pod Wed Aug 13 06:10:04 2003
@@ -105,9 +105,9 @@
When directed at a process whose UID is not identical to that
of the sending process, signal number zero may fail because
you lack permission to send the signal, even though the process is alive.
-You may be able to determine the cause of failure using C<$!>.
+You may be able to determine the cause of failure using C<%!>.
- unless (kill 0 => $pid or $! == $!{EPERM}) {
+ unless (kill 0 => $pid or $!{EPERM}) {
warn "$pid looks dead";
}
==== //depot/maint-5.8/perl/pod/perlport.pod#12 (text) ====
Index: perl/pod/perlport.pod
--- perl/pod/perlport.pod#11~20397~ Thu Jul 31 13:41:00 2003
+++ perl/pod/perlport.pod Wed Aug 13 06:10:04 2003
@@ -494,12 +494,25 @@
Don't assume that there is only one way to get through firewalls
to the public Internet.
+Don't assume that you can reach outside world through any other port
+than 80, or some web proxy. ftp is blocked by many firewalls.
+
Don't assume that you can reach yourself or any node by the name
-'localhost'. The same goes for '127.0.0.1'.
+'localhost'. The same goes for '127.0.0.1'. You will have to try
+both.
+
+Don't assume that the host has only one network card, or that it
+can't bind to many virtual IP addresses.
+
+Don't assume a particular network device name.
Don't assume that any particular port (service) will respond.
Don't assume that you can ping hosts and get replies.
+
+All the above "don't":s may look daunting, and they are -- but the key
+is to degrade gracefully if one cannot reach the particular network
+service one wants. Croaking or hanging do not look very professional.
=head2 Interprocess Communication (IPC)
==== //depot/maint-5.8/perl/pod/perlrun.pod#28 (text) ====
Index: perl/pod/perlrun.pod
--- perl/pod/perlrun.pod#27~20244~ Sun Jul 27 13:35:49 2003
+++ perl/pod/perlrun.pod Wed Aug 13 06:10:04 2003
@@ -940,9 +940,23 @@
=item :crlf
-A layer that implements DOS/Windows like CRLF line endings.
-On read converts pairs of CR,LF to a single "\n" newline character.
-On write converts each "\n" to a CR,LF pair.
+A layer that implements DOS/Windows like CRLF line endings. On read
+converts pairs of CR,LF to a single "\n" newline character. On write
+converts each "\n" to a CR,LF pair. Note that this layer likes to be
+one of its kind: it silently ignores attempts to be pushed into the
+layer stack more than once.
+
+(Gory details follow) To be more exact what happens is this: after
+pushing itself to the stack, the C<:crlf> layer checks all the layers
+below itself to find the first layer that is capable of being a CRLF
+layer but is not yet enabled to be a CRLF layer. If it finds such a
+layer, it enables the CRLFness of that other deeper layer, and then
+pops itself off the stack. If not, fine, use the one we just pushed.
+
+The end result is that a C<:crlf> means "please enable the first CRLF
+layer you can find, and if you can't find one, here would be a good
+spot to place a new one."
+
Based on the C<:perlio> layer.
=item :mmap
==== //depot/maint-5.8/perl/t/io/crlf.t#6 (text) ====
Index: perl/t/io/crlf.t
--- perl/t/io/crlf.t#5~18946~ Tue Mar 11 22:13:00 2003
+++ perl/t/io/crlf.t Wed Aug 13 06:10:04 2003
@@ -11,11 +11,11 @@
my $file = "crlf$$.dat";
END {
- unlink($file);
+ 1 while unlink($file);
}
if (find PerlIO::Layer 'perlio') {
- plan(tests => 8);
+ plan(tests => 16);
ok(open(FOO,">:crlf",$file));
ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO));
ok(open(FOO,"<:crlf",$file));
@@ -47,6 +47,31 @@
}
ok(close(FOO));
+
+ # binmode :crlf should not cumulate.
+ # Try it first once and then twice so that even UNIXy boxes
+ # get to exercise this, for DOSish boxes even once is enough.
+ # Try also pushing :utf8 first so that there are other layers
+ # in between (this should not matter: CRLF layers still should
+ # not accumulate).
+ for my $utf8 ('', ':utf8') {
+ for my $binmode (1..2) {
+ open(FOO, ">$file");
+ # require PerlIO; print PerlIO::get_layers(FOO), "\n";
+ binmode(FOO, "$utf8:crlf") for 1..$binmode;
+ # require PerlIO; print PerlIO::get_layers(FOO), "\n";
+ print FOO "Hello\n";
+ close FOO;
+ open(FOO, "<$file");
+ binmode(FOO);
+ my $foo = scalar <FOO>;
+ close FOO;
+ print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)),
+ "\n";
+ ok($foo =~ /\x0d\x0a$/);
+ ok($foo !~ /\x0d\x0d/);
+ }
+ }
}
else {
skip_all("No perlio, so no :crlf");
==== //depot/maint-5.8/perl/t/io/layers.t#9 (text) ====
Index: perl/t/io/layers.t
--- perl/t/io/layers.t#8~19682~ Tue Jun 3 22:22:46 2003
+++ perl/t/io/layers.t Wed Aug 13 06:10:04 2003
@@ -25,8 +25,6 @@
$PERLIO = exists $ENV{PERLIO} ? $ENV{PERLIO} : "(undef)";
}
-plan tests => 43;
-
use Config;
my $DOSISH = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0;
@@ -34,6 +32,10 @@
my $NONSTDIO = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio' ? 1 : 0;
my $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio} ? 1 : 0;
+my $NTEST = 43 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0);
+
+plan tests => $NTEST;
+
print <<__EOH__;
# PERLIO = $PERLIO
# DOSISH = $DOSISH
@@ -42,7 +44,7 @@
__EOH__
SKIP: {
- skip("This perl does not have Encode", 43)
+ skip("This perl does not have Encode", $NTEST)
unless " $Config{extensions} " =~ / Encode /;
sub check {
@@ -80,8 +82,14 @@
$result->[0] eq "unix" &&
$result->[1] eq "crlf";
}
+ if ($DOSISH && grep { $_ eq 'crlf' } @$expected) {
+ # 5 tests potentially skipped because
+ # DOSISH systems already have a CRLF layer
+ # which will make new ones not stick.
+ @$expected = grep { $_ ne 'crlf' } @$expected;
+ }
my $n = scalar @$expected;
- is($n, scalar @$expected, "$id - layers = $n");
+ is($n, scalar @$expected, "$id - layers == $n");
for (my $i = 0; $i < $n; $i++) {
my $j = $expected->[$i];
if (ref $j eq 'CODE') {
@@ -122,7 +130,6 @@
[ "stdio" ],
":raw");
- binmode(F, ":pop") if $DOSISH; # Drop one extra :crlf.
binmode(F, ":utf8");
check([ PerlIO::get_layers(F) ],
@@ -149,9 +156,8 @@
binmode(F, ":raw :encoding(latin1)"); # "latin1" will be canonized
- SKIP: {
- skip("too complex layer coreography", 7) if $DOSISH || !$FASTSTDIO;
-
+ # 7 tests potentially skipped.
+ unless ($DOSISH || !$FASTSTDIO) {
my @results = PerlIO::get_layers(F, details => 1);
# Get rid of the args and the flags.
==== //depot/maint-5.8/perl/vms/descrip_mms.template#13 (text) ====
Index: perl/vms/descrip_mms.template
--- perl/vms/descrip_mms.template#12~20667~ Tue Aug 12 13:04:53 2003
+++ perl/vms/descrip_mms.template Wed Aug 13 06:10:04 2003
@@ -858,6 +858,10 @@
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+[.lib.pod]perlgpl.pod : [.pod]perlgpl.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+
[.lib.pod]perlguts.pod : [.pod]perlguts.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
End of Patch.
