concat.t cleanup (no concats!)

[Joe McMahon]

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");
 }