diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-12-23 12:58:58 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1996-12-23 12:58:58 +1200 |
commit | 71be2cbc73608e37e1a2ab7e459a02111137d1b0 (patch) | |
tree | 86679f00907a9abdfd1ff5104cec60d9a9fb0ef9 /t | |
parent | b133f4ec823b00faf9bd083e0eb8e7a53ba7bfca (diff) | |
download | perl-71be2cbc73608e37e1a2ab7e459a02111137d1b0.tar.gz |
[inseparable changes from patch from perl5.003_13 to perl5.003_14]
CORE LANGUAGE CHANGES
Subject: Eliminate support for {if,unless,while,until} BLOCK BLOCK
From: Chip Salzenberg <chip@atlantic.net>
Files: perly.c perly.c.diff perly.y toke.c
Subject: Taint $x after $x =~ s/pat/xyz/ if pat or xyz is tainted by locale
From: Chip Salzenberg <chip@atlantic.net>
Files: cop.h mg.c pp_ctl.c pp_hot.c
Subject: Complete support for modifying undefined array members in foreach
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym mg.c perl.h pp.c pp_hot.c proto.h sv.c
DOCUMENTATION
Subject: Update pod/Makefile; s/perli18n/perllocale/
From: Chip Salzenberg <chip@atlantic.net>
Files: ext/POSIX/POSIX.pod lib/I18N/Collate.pm pod/Makefile pod/perl.pod pod/perlmod.pod pod/perlnews.pod pod/roffitall
OTHER CORE CHANGES
Subject: Bug in debugger with import manipulations
Date: Mon, 23 Dec 1996 05:37:48 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: pp_hot.c
Finally I traced why MakeMaker runs wrongly under debugger: debugger
function calling sequence was assuming that
GvCV(CvGV(cv)) == cv
for non-anonymous subs (ne END). MakeMaker managed to break it by
*A::B = \&C::D;
eval 'sub C::D {new one}';
After this CvGV(\&A::B) is *C::D, but &{*C::D} is the "new one".
Patch follows (note that in this case we do not sacrifice having a
subroutine name in debugger output ;-).
Enjoy,
p5p-msgid: <199612231037.FAA08617@monk.mps.ohio-state.edu>
Subject: Import and dynamic methods
Date: Mon, 23 Dec 1996 01:45:37 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: gv.c hv.c sv.c
Here is the patch which corrects bad things which happens when you
import subroutines and otherwise manipulate the symbol tree.
I put forward the only chunk which may be controversal, since it may
have a minor performance penalty. It is independent of the others, so
it can be freely deleted.
The manipulations which correctly propagate to method calls:
a) Pruning globs: delete $B::{method}
b) Undefing subroutines: undef &B::method;
c) Importing: *B::method = \&mymethod;
Enjoy,
p5p-msgid: <199612230645.BAA08378@monk.mps.ohio-state.edu>
Subject: sv_gets patch
Date: Sun, 22 Dec 1996 03:24:04 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: pp_hot.c
I sent this patch before as a part of
pos $str =
$str = /failing/g
patch. Now I separate it in the case it was tainted by environment:
Synopsis:
$a = <FH>;
does not work as expected if $a is magic (say, tied).
Enjoy,
p5p-msgid: <199612220824.DAA07235@monk.mps.ohio-state.edu>
Subject: pos $str patch
Date: Sun, 22 Dec 1996 03:31:21 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: mg.c pp_hot.c t/op/pat.t
This patch was (mostly) posted already.
It fixes the bug:
pos $str
is reset to undef if
$str =~ /failing/g
fails.
Additionally, if fixes the hidded bit (=MGf_MINMATCH) surviving
setting
pos $str = ...
Enjoy,
p5p-msgid: <199612220831.DAA07247@monk.mps.ohio-state.edu>
PORTABILITY
Subject: Fix bugs in bincompat3 usage
From: Chip Salzenberg <chip@atlantic.net>
Files: perl.h perl_exp.SH
Subject: VMS patches to 5.003_13
Date: Mon, 23 Dec 1996 01:26:47 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: deb.c ext/POSIX/POSIX.xs gv.c lib/File/Copy.pm mg.c perl.c perl.h proto.h sv.c t/lib/filecopy.t taint.c toke.c util.c vms/Makefile vms/config.vms vms/descrip.mms vms/gen_shrfls.pl vms/genconfig.pl vms/genopt.com vms/perly_c.vms vms/perly_h.vms vms/test.com vms/vms.c vms/vms_yfix.pl
private-msgid: <01IDBYYFYPIS002ASE@hmivax.humgen.upenn.edu>
UTILITIES, LIBRARY, AND EXTENSIONS
Subject: Remove libnet
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST pod/perlmod.pod
Subject: Update IO->VERSION() to 1.1201 for CPAN's sake
From: Chip Salzenberg <chip@atlantic.net>
Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm
Subject: Remodel File::Copy.
From: Chip Salzenberg <chip@atlantic.net>
Files: lib/File/Copy.pm
Diffstat (limited to 't')
-rwxr-xr-x | t/lib/filecopy.t | 51 | ||||
-rwxr-xr-x | t/lib/open2.t | 2 | ||||
-rwxr-xr-x | t/lib/open3.t | 2 | ||||
-rwxr-xr-x | t/op/pat.t | 16 |
4 files changed, 61 insertions, 10 deletions
diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t index 8c64be1c98..0a5f4c180c 100755 --- a/t/lib/filecopy.t +++ b/t/lib/filecopy.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print "1..5\n"; +print "1..11\n"; $| = 1; @@ -29,15 +29,56 @@ print "not " unless $foo eq "ok 3\n"; print "ok 2\n"; copy "copy-$$", \*STDOUT; +unlink "copy-$$"; +open(F,"file-$$"); +copy(*F, "copy-$$"); +open(R, "copy-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n"; +print "ok 4\n"; +unlink "copy-$$"; +open(F,"file-$$"); +copy(\*F, "copy-$$"); +open(R, "copy-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n"; +print "ok 5\n"; +unlink "copy-$$"; + +require IO::File; +$fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!"; +copy("file-$$",$fh); +$fh->close; +open(R, "copy-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n"; +print "ok 6\n"; +unlink "copy-$$"; +require FileHandle; +my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!"; +copy("file-$$",$fh); +$fh->close; +open(R, "copy-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n"; +print "ok 7\n"; unlink "file-$$"; print "not " if move("file-$$", "copy-$$") or not -e "copy-$$"; -print "ok 4\n"; +print "ok 8\n"; move "copy-$$", "file-$$"; - print "not " unless -e "file-$$" and not -e "copy-$$"; -print "ok 5\n"; +open(R, "file-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n"; +print "ok 9\n"; + +copy "file-$$", "lib"; +open(R, "lib/file-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n"; +print "ok 10\n"; +unlink "lib/file-$$"; + +move "file-$$", "lib"; +open(R, "lib/file-$$") or die; $foo = <R>; close(R); +print "not " unless $foo eq "ok 3\n" and not -e "file-$$";; +print "ok 11\n"; +unlink "lib/file-$$"; -unlink "file-$$"; diff --git a/t/lib/open2.t b/t/lib/open2.t index 8dd786b76e..1cf325a875 100755 --- a/t/lib/open2.t +++ b/t/lib/open2.t @@ -1,5 +1,4 @@ #!./perl -w -use strict; BEGIN { chdir 't' if -d 't'; @@ -8,6 +7,7 @@ BEGIN { $SIG{__WARN__} = sub { die @_ }; } +use strict; use IO::Handle; use IPC::Open2; #require 'open2.pl'; use subs 'open2'; diff --git a/t/lib/open3.t b/t/lib/open3.t index a4a978ebea..a5d7f2e8ee 100755 --- a/t/lib/open3.t +++ b/t/lib/open3.t @@ -1,5 +1,4 @@ #!./perl -w -use strict; BEGIN { chdir 't' if -d 't'; @@ -8,6 +7,7 @@ BEGIN { $SIG{__WARN__} = sub { die @_ }; } +use strict; use IO::Handle; use IPC::Open3; #require 'open3.pl'; use subs 'open3'; diff --git a/t/op/pat.t b/t/op/pat.t index d93e6d66e2..d9941fa816 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -2,7 +2,7 @@ # $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $ -print "1..60\n"; +print "1..61\n"; $x = "abc\ndef\n"; @@ -134,17 +134,19 @@ print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to" : "not ok 45\n"; @words = (); +pos = 0; while (/to/g) { push(@words, $&); } print join(':',@words) eq "to:to" ? "ok 46\n" - : "not ok 46 @words\n"; + : "not ok 46 `@words'\n"; +pos $_ = 0; @words = /to/g; print join(':',@words) eq "to:to" ? "ok 47\n" - : "not ok 47 @words\n"; + : "not ok 47 `@words'\n"; $_ = "abcdefghi"; @@ -191,12 +193,14 @@ $x=/abc/g; print $` eq "abcfoo" ? "ok 53\n" : "not ok 53\n" if $x; $x=/abc/g; print $x == 0 ? "ok 54\n" : "not ok 54\n"; +pos = 0; $x=/ABC/gi; print $` eq "" ? "ok 55\n" : "not ok 55\n" if $x; $x=/ABC/gi; print $` eq "abcfoo" ? "ok 56\n" : "not ok 56\n" if $x; $x=/ABC/gi; print $x == 0 ? "ok 57\n" : "not ok 57\n"; +pos = 0; $x=/abc/g; print $' eq "fooabcbar" ? "ok 58\n" : "not ok 58\n" if $x; $x=/abc/g; @@ -204,3 +208,9 @@ print $' eq "bar" ? "ok 59\n" : "not ok 59\n" if $x; $_ .= ''; @x=/abc/g; print scalar @x == 2 ? "ok 60\n" : "not ok 60\n"; + +$_ = "abdc"; +pos $_ = 2; +/\Gc/g; +print "not " if (pos $_) != 2; +print "ok 61\n"; |