perl 4.0 patch 10: (combined patch)

Subject: pack(hh,1) dumped core
Subject: read didn't work from character special files open for writing
Subject: close-on-exec wrongly set on system file descriptors
Subject: //g only worked first time through
Subject: perl -v printed incorrect copyright notice
Subject: certain pattern optimizations were botched
Subject: documented some newer features in addenda
Subject: $) and $| incorrectly handled in run-time patterns
Subject: added tests for case-insensitive regular expressions
Subject: m'$foo' now treats string as single quoted

3 files changed, 151 insertions, 4 deletions

diff --git a/t/op/pat.t b/t/op/pat.t
index 5223ef0be0..8c3adc975d 100644
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -1,8 +1,8 @@
 #!./perl
 
-# $RCSfile: pat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:01:26 $
+# $RCSfile: pat.t,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:29:34 $
 
-print "1..48\n";
+print "1..51\n";
 
 $x = "abc\ndef\n";
 
@@ -174,3 +174,11 @@ for $iter (1..5) {
 
 $x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
 print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
+
+$xyz = 'xyz';
+print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n";
+
+# perl 4.009 says "unmatched ()"
+eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
+print $@ eq "" ? "ok 50\n" : "not ok 50\n";
+print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n";
diff --git a/t/op/re_tests b/t/op/re_tests
index 01d9940216..ee03d6fdbd 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -135,3 +135,140 @@ a(bc)d	abcd	y	$1-\$1-\\$1	bc-$1-\bc
 a[-]?c	ac	y	$&	ac
 (abc)\1	abcabc	y	$1	abc
 ([a-c]*)\1	abcabc	y	$1	abc
+'abc'i	ABC	y	$&	ABC
+'abc'i	XBC	n	-	-
+'abc'i	AXC	n	-	-
+'abc'i	ABX	n	-	-
+'abc'i	XABCY	y	$&	ABC
+'abc'i	ABABC	y	$&	ABC
+'ab*c'i	ABC	y	$&	ABC
+'ab*bc'i	ABC	y	$&	ABC
+'ab*bc'i	ABBC	y	$&	ABBC
+'ab*bc'i	ABBBBC	y	$&	ABBBBC
+'ab{0,}bc'i	ABBBBC	y	$&	ABBBBC
+'ab+bc'i	ABBC	y	$&	ABBC
+'ab+bc'i	ABC	n	-	-
+'ab+bc'i	ABQ	n	-	-
+'ab{1,}bc'i	ABQ	n	-	-
+'ab+bc'i	ABBBBC	y	$&	ABBBBC
+'ab{1,}bc'i	ABBBBC	y	$&	ABBBBC
+'ab{1,3}bc'i	ABBBBC	y	$&	ABBBBC
+'ab{3,4}bc'i	ABBBBC	y	$&	ABBBBC
+'ab{4,5}bc'i	ABBBBC	n	-	-
+'ab?bc'i	ABBC	y	$&	ABBC
+'ab?bc'i	ABC	y	$&	ABC
+'ab{0,1}bc'i	ABC	y	$&	ABC
+'ab?bc'i	ABBBBC	n	-	-
+'ab?c'i	ABC	y	$&	ABC
+'ab{0,1}c'i	ABC	y	$&	ABC
+'^abc$'i	ABC	y	$&	ABC
+'^abc$'i	ABCC	n	-	-
+'^abc'i	ABCC	y	$&	ABC
+'^abc$'i	AABC	n	-	-
+'abc$'i	AABC	y	$&	ABC
+'^'i	ABC	y	$&	
+'$'i	ABC	y	$&	
+'a.c'i	ABC	y	$&	ABC
+'a.c'i	AXC	y	$&	AXC
+'a.*c'i	AXYZC	y	$&	AXYZC
+'a.*c'i	AXYZD	n	-	-
+'a[bc]d'i	ABC	n	-	-
+'a[bc]d'i	ABD	y	$&	ABD
+'a[b-d]e'i	ABD	n	-	-
+'a[b-d]e'i	ACE	y	$&	ACE
+'a[b-d]'i	AAC	y	$&	AC
+'a[-b]'i	A-	y	$&	A-
+'a[b-]'i	A-	y	$&	A-
+'a[b-a]'i	-	c	-	-
+'a[]b'i	-	c	-	-
+'a['i	-	c	-	-
+'a]'i	A]	y	$&	A]
+'a[]]b'i	A]B	y	$&	A]B
+'a[^bc]d'i	AED	y	$&	AED
+'a[^bc]d'i	ABD	n	-	-
+'a[^-b]c'i	ADC	y	$&	ADC
+'a[^-b]c'i	A-C	n	-	-
+'a[^]b]c'i	A]C	n	-	-
+'a[^]b]c'i	ADC	y	$&	ADC
+'ab|cd'i	ABC	y	$&	AB
+'ab|cd'i	ABCD	y	$&	AB
+'()ef'i	DEF	y	$&-$1	EF-
+'()*'i	-	c	-	-
+'*a'i	-	c	-	-
+'^*'i	-	c	-	-
+'$*'i	-	c	-	-
+'(*)b'i	-	c	-	-
+'$b'i	B	n	-	-
+'a\'i	-	c	-	-
+'a\(b'i	A(B	y	$&-$1	A(B-
+'a\(*b'i	AB	y	$&	AB
+'a\(*b'i	A((B	y	$&	A((B
+'a\\b'i	A\B	y	$&	A\B
+'abc)'i	-	c	-	-
+'(abc'i	-	c	-	-
+'((a))'i	ABC	y	$&-$1-$2	A-A-A
+'(a)b(c)'i	ABC	y	$&-$1-$2	ABC-A-C
+'a+b+c'i	AABBABC	y	$&	ABC
+'a{1,}b{1,}c'i	AABBABC	y	$&	ABC
+'a**'i	-	c	-	-
+'a*?'i	-	c	-	-
+'(a*)*'i	-	c	-	-
+'(a*)+'i	-	c	-	-
+'(a|)*'i	-	c	-	-
+'(a*|b)*'i	-	c	-	-
+'(a+|b)*'i	AB	y	$&-$1	AB-B
+'(a+|b){0,}'i	AB	y	$&-$1	AB-B
+'(a+|b)+'i	AB	y	$&-$1	AB-B
+'(a+|b){1,}'i	AB	y	$&-$1	AB-B
+'(a+|b)?'i	AB	y	$&-$1	A-A
+'(a+|b){0,1}'i	AB	y	$&-$1	A-A
+'(^)*'i	-	c	-	-
+'(ab|)*'i	-	c	-	-
+')('i	-	c	-	-
+'[^ab]*'i	CDE	y	$&	CDE
+'abc'i		n	-	-
+'a*'i		y	$&	
+'([abc])*d'i	ABBBCD	y	$&-$1	ABBBCD-C
+'([abc])*bcd'i	ABCD	y	$&-$1	ABCD-A
+'a|b|c|d|e'i	E	y	$&	E
+'(a|b|c|d|e)f'i	EF	y	$&-$1	EF-E
+'((a*|b))*'i	-	c	-	-
+'abcd*efg'i	ABCDEFG	y	$&	ABCDEFG
+'ab*'i	XABYABBBZ	y	$&	AB
+'ab*'i	XAYABBBZ	y	$&	A
+'(ab|cd)e'i	ABCDE	y	$&-$1	CDE-CD
+'[abhgefdc]ij'i	HIJ	y	$&	HIJ
+'^(ab|cd)e'i	ABCDE	n	x$1y	XY
+'(abc|)ef'i	ABCDEF	y	$&-$1	EF-
+'(a|b)c*d'i	ABCD	y	$&-$1	BCD-B
+'(ab|ab*)bc'i	ABC	y	$&-$1	ABC-A
+'a([bc]*)c*'i	ABC	y	$&-$1	ABC-BC
+'a([bc]*)(c*d)'i	ABCD	y	$&-$1-$2	ABCD-BC-D
+'a([bc]+)(c*d)'i	ABCD	y	$&-$1-$2	ABCD-BC-D
+'a([bc]*)(c+d)'i	ABCD	y	$&-$1-$2	ABCD-B-CD
+'a[bcd]*dcdcde'i	ADCDCDE	y	$&	ADCDCDE
+'a[bcd]+dcdcde'i	ADCDCDE	n	-	-
+'(ab|a)b*c'i	ABC	y	$&-$1	ABC-AB
+'((a)(b)c)(d)'i	ABCD	y	$1-$2-$3-$4	ABC-A-B-D
+'[a-zA-Z_][a-zA-Z0-9_]*'i	ALPHA	y	$&	ALPHA
+'^a(bc+|b[eh])g|.h$'i	ABH	y	$&-$1	BH-
+'(bc+d$|ef*g.|h?i(j|k))'i	EFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
+'(bc+d$|ef*g.|h?i(j|k))'i	IJ	y	$&-$1-$2	IJ-IJ-J
+'(bc+d$|ef*g.|h?i(j|k))'i	EFFG	n	-	-
+'(bc+d$|ef*g.|h?i(j|k))'i	BCDD	n	-	-
+'(bc+d$|ef*g.|h?i(j|k))'i	REFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
+'((((((((((a))))))))))'i	A	y	$10	A
+'((((((((((a))))))))))\10'i	AA	y	$&	AA
+'((((((((((a))))))))))\41'i	AA	n	-	-
+'((((((((((a))))))))))\41'i	A!	y	$&	A!
+'(((((((((a)))))))))'i	A	y	$&	A
+'multiple words of text'i	UH-UH	n	-	-
+'multiple words'i	MULTIPLE WORDS, YEAH	y	$&	MULTIPLE WORDS
+'(.*)c(.*)'i	ABCDE	y	$&-$1-$2	ABCDE-AB-DE
+'\((.*), (.*)\)'i	(A, B)	y	($2, $1)	(B, A)
+'[k]'i	AB	n	-	-
+'abcd'i	ABCD	y	$&-\$&-\\$&	ABCD-$&-\ABCD
+'a(bc)d'i	ABCD	y	$1-\$1-\\$1	BC-$1-\BC
+'a[-]?c'i	AC	y	$&	AC
+'(abc)\1'i	ABCABC	y	$1	ABC
+'([a-c]*)\1'i	ABCABC	y	$1	ABC
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 92f084a7f0..e488a82a61 100644
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: regexp.t,v 4.0 91/03/20 01:54:22 lwall Locked $
+# $RCSfile: regexp.t,v $$Revision: 4.0.1.1 $$Date: 91/06/10 01:30:29 $
 
 open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
     || die "Can't open re_tests";
@@ -11,10 +11,12 @@ close(TESTS);
 print "1..$numtests\n";
 open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
     || die "Can't open re_tests";
+$| = 1;
 while (<TESTS>) {
     ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
     $input = join(':',$pat,$subject,$result,$repl,$expect);
-    eval "\$match = (\$subject =~ \$pat); \$got = \"$repl\";";
+    $pat = "'$pat'" unless $pat =~ /^'/;
+    eval "\$match = (\$subject =~ m$pat); \$got = \"$repl\";";
     if ($result eq 'c') {
 	if ($@ ne '') {print "ok $.\n";} else {print "not ok $.\n";}
     }