From: Nicholas Clark Date: Thu, 6 Jan 2005 14:34:24 +0000 (+0000) Subject: All tests now use test.pl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c509eb921569425706e6fe39ea7cb2f11e99d1b;p=p5sagit%2Fp5-mst-13.2.git All tests now use test.pl p4raw-id: //depot/perl@23759 --- diff --git a/t/op/ref.t b/t/op/ref.t index edd6f70..c0d86a6 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -7,52 +7,53 @@ BEGIN { require 'test.pl'; -plan (72); +plan (74); # Test glob operations. -$bar = "ok 1\n"; -$foo = "ok 2\n"; +$bar = "one"; +$foo = "two"; { local(*foo) = *bar; - print $foo; + is($foo, 'one'); } -print $foo; +is ($foo, 'two'); -$baz = "ok 3\n"; -$foo = "ok 4\n"; +$baz = "three"; +$foo = "four"; { local(*foo) = 'baz'; - print $foo; + is ($foo, 'three'); } -print $foo; +is ($foo, 'four'); -$foo = "ok 6\n"; +$foo = "global"; { local(*foo); - print $foo; - $foo = "ok 5\n"; - print $foo; + is ($foo, undef); + $foo = "local"; + is ($foo, 'local'); } -print $foo; +is ($foo, 'global'); # Test fake references. -$baz = "ok 7\n"; +$baz = "valid"; $bar = 'baz'; $foo = 'bar'; -print $$$foo; +is ($$$foo, 'valid'); # Test real references. $FOO = \$BAR; $BAR = \$BAZ; -$BAZ = "ok 8\n"; -print $$$FOO; +$BAZ = "hit"; +is ($$$FOO, 'hit'); # Test references to real arrays. -@ary = (9,10,11,12); +my $test = curr_test(); +@ary = ($test,$test+1,$test+2,$test+3); $ref[0] = \@a; $ref[1] = \@b; $ref[2] = \@c; @@ -64,102 +65,108 @@ print @a; print ${$ref[1]}[0]; print @{$ref[2]}[0]; print @{'d'}; +curr_test($test+4); # Test references to references. $refref = \\$x; -$x = "ok 13\n"; -print $$$refref; +$x = "Good"; +is ($$$refref, 'Good'); # Test nested anonymous lists. $ref = [[],2,[3,4,5,]]; -print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n"; -print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n"; -print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n"; -print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n"; +is (scalar @$ref, 3); +is ($$ref[1], 2); +is (${$$ref[2]}[2], 5); +is (scalar @{$$ref[0]}, 0); -print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n"; -print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 19\n"; +is ($ref->[1], 2); +is ($ref->[2]->[0], 3); # Test references to hashes of references. $refref = \%whatever; $refref->{"key"} = $ref; -print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n"; +is ($refref->{"key"}->[2]->[0], 3); # Test to see if anonymous subarrays spring into existence. $spring[5]->[0] = 123; $spring[5]->[1] = 456; push(@{$spring[5]}, 789); -print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n"; +is (join(':',@{$spring[5]}), "123:456:789"); # Test to see if anonymous subhashes spring into existence. @{$spring2{"foo"}} = (1,2,3); $spring2{"foo"}->[3] = 4; -print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n"; +is (join(':',@{$spring2{"foo"}}), "1:2:3:4"); # Test references to subroutines. -sub mysub { print "ok 23\n" } -$subref = \&mysub; -&$subref; +{ + my $called; + sub mysub { $called++; } + $subref = \&mysub; + &$subref; + is ($called, 1); +} $subrefref = \\&mysub2; -$$subrefref->("ok 24\n"); -sub mysub2 { print shift } +is ($$subrefref->("GOOD"), "good"); +sub mysub2 { lc shift } # Test the ref operator. -print ref $subref eq CODE ? "ok 25\n" : "not ok 25\n"; -print ref $ref eq ARRAY ? "ok 26\n" : "not ok 26\n"; -print ref $refref eq HASH ? "ok 27\n" : "not ok 27\n"; +is (ref $subref, 'CODE'); +is (ref $ref, 'ARRAY'); +is (ref $refref, 'HASH'); # Test anonymous hash syntax. $anonhash = {}; -print ref $anonhash eq HASH ? "ok 28\n" : "not ok 28\n"; +is (ref $anonhash, 'HASH'); $anonhash2 = {FOO => BAR, ABC => XYZ,}; -print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n"; +is (join('', sort values %$anonhash2), 'BARXYZ'); # Test bless operator. package MYHASH; $object = bless $main'anonhash2; -print ref $object eq MYHASH ? "ok 30\n" : "not ok 30\n"; -print $object->{ABC} eq XYZ ? "ok 31\n" : "not ok 31\n"; +main::is (ref $object, 'MYHASH'); +main::is ($object->{ABC}, 'XYZ'); $object2 = bless {}; -print ref $object2 eq MYHASH ? "ok 32\n" : "not ok 32\n"; +main::is (ref $object2, 'MYHASH'); # Test ordinary call on object method. -&mymethod($object,33); +&mymethod($object,"argument"); sub mymethod { local($THIS, @ARGS) = @_; die 'Got a "' . ref($THIS). '" instead of a MYHASH' unless ref $THIS eq MYHASH; - print $THIS->{FOO} eq BAR ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n"; + main::is ($ARGS[0], "argument"); + main::is ($THIS->{FOO}, 'BAR'); } # Test automatic destructor call. -$string = "not ok 34\n"; +$string = "bad"; $object = "foo"; -$string = "ok 34\n"; +$string = "good"; $main'anonhash2 = "foo"; $string = ""; DESTROY { return unless $string; - print $string; + main::is ($string, 'good'); # Test that the object has not already been "cursed". - print ref shift ne HASH ? "ok 35\n" : "not ok 35\n"; + main::isnt (ref shift, 'HASH'); } # Now test inheritance of methods. @@ -171,7 +178,6 @@ package OBJ; $main'object = bless {FOO => foo, BAR => bar}; package main; -curr_test(36); # Test arrow-style method invocation. @@ -220,7 +226,7 @@ eval '\\($x, $y) = (1, 2);'; like ($@, qr/Can\'t modify.*ref.*in.*assignment/); # test for proper destruction of lexical objects -my $test = curr_test(); +$test = curr_test(); sub larry::DESTROY { print "# larry\nok $test\n"; } sub curly::DESTROY { print "# curly\nok ", $test + 1, "\n"; } sub moe::DESTROY { print "# moe\nok ", $test + 2, "\n"; }