I took the printf(), added an sprintf() and another conditional operator, and got the following: my $test = 1; sub ok { my($ok, $name) = @_; printf "%sok %d - %s%s\n", $ok ? "" : "not ", $test, $name, ($ok ? "" : sprintf("\t# Failed test at line %d\n", (caller)[2])); $test++; return $ok; } So now ok() handles the "not " and the caller info in one slightly more complez printf, which I think should definitely meet the VMS limitation. Also, there were a couple of places where the test was for a "Modification of a read-only value attempted at ..." message, so I added a couple of eval{} blocks and tested $@ in those cases. I think that covers the bases for concat.t now. Full patch attached. --- Joe M.
--- old_op/concat.t Sun Aug 12 00:34:56 2001 +++ op/concat.t Thu Aug 30 16:26:00 2001 @@ -5,49 +5,47 @@ @INC = '../lib'; } -print "1..11\n"; +my $test = 1; +sub ok { + my($ok, $name) = @_; + + printf "%sok %d - %s%s\n", $ok ? "" : "not ", $test, $name, + ($ok ? "" : sprintf("\t# Failed test at line %d\n", (caller)[2])); + + $test++; + return $ok; +} ($a, $b, $c) = qw(foo bar); -print "not " unless "$a" eq "foo"; -print "ok 1\n"; +ok("$a" eq "foo", "verifying assign"); -print "not " unless "$a$b" eq "foobar"; -print "ok 2\n"; +ok("$a$b" eq "foobar", "basic concatenation"); -print "not " unless "$c$a$c" eq "foo"; -print "ok 3\n"; +ok("$c$a$c" eq "foo", "concatenate undef, fore and aft"); # Okay, so that wasn't very challenging. Let's go Unicode. -my $test = 4; - { # bug id 20000819.004 $_ = $dx = "\x{10f2}"; s/($dx)/$dx$1/; { - print "not " unless $_ eq "$dx$dx"; - print "ok $test\n"; - $test++; + ok($_ eq "$dx$dx","bug id 20000819.004, back"); } $_ = $dx = "\x{10f2}"; s/($dx)/$1$dx/; { - print "not " unless $_ eq "$dx$dx"; - print "ok $test\n"; - $test++; + ok($_ eq "$dx$dx","bug id 20000819.004, front"); } $dx = "\x{10f2}"; $_ = "\x{10f2}\x{10f2}"; s/($dx)($dx)/$1$2/; { - print "not " unless $_ eq "$dx$dx"; - print "ok $test\n"; - $test++; + ok($_ eq "$dx$dx","bug id 20000819.004, front and back"); } } @@ -57,9 +55,9 @@ my $a; $a .= "\x{1ff}"; - print "not " unless $a eq "\x{1ff}"; - print "ok $test\n"; - $test++; + ok($a eq "\x{1ff}", "bug id 20000901.092, undef left"); + $a .= undef; + ok($a eq "\x{1ff}", "bug id 20000901.092, undef right"); } { @@ -69,29 +67,21 @@ # Without the fix this 5.7.0 would croak: # Modification of a read-only value attempted at ... - "$2\x{1234}"; - - print "ok $test\n"; - $test++; + eval {"$2\x{1234}"}; + ok(!$@, "bug id 20001020.006, left"); # For symmetry with the above. - "\x{1234}$2"; - - print "ok $test\n"; - $test++; + eval {"\x{1234}$2"}; + ok(!$@, "bug id 20001020.006, right"); *pi = \undef; # This bug existed earlier than the $2 bug, but is fixed with the same # patch. Without the fix this 5.7.0 would also croak: # Modification of a read-only value attempted at ... - "$pi\x{1234}"; - - print "ok $test\n"; - $test++; + eval{"$pi\x{1234}"}; + ok(!$@, "bug id 20001020.006, constant left"); # For symmetry with the above. - "\x{1234}$pi"; - - print "ok $test\n"; - $test++; + eval{"\x{1234}$pi"}; + ok(!$@, "bug id 20001020.006, constant right"); }