From: Jarkko Hietaniemi Date: Thu, 4 Apr 2002 22:10:51 +0000 (+0000) Subject: test.pl-ify. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6dc4e5ce3856b98c7d128e411610d5f3845c15f3;p=p5sagit%2Fp5-mst-13.2.git test.pl-ify. p4raw-id: //depot/perl@15735 --- diff --git a/t/op/method.t b/t/op/method.t index 0ce8ce8..16a927a 100755 --- a/t/op/method.t +++ b/t/op/method.t @@ -6,7 +6,8 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + @INC = qw(. ../lib); + require "test.pl"; } print "1..74\n"; @@ -17,70 +18,63 @@ print "1..74\n"; sub C::d {"C::d"} sub D::d {"D::d"} -my $cnt = 0; -sub test { - print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1]; - # print "not " unless shift eq shift; - print "ok ", ++$cnt, "\n" -} - # First, some basic checks of method-calling syntax: $obj = bless [], "Pack"; sub Pack::method { shift; join(",", "method", @_) } $mname = "method"; -test(Pack->method("a","b","c"), "method,a,b,c"); -test(Pack->$mname("a","b","c"), "method,a,b,c"); -test(method Pack ("a","b","c"), "method,a,b,c"); -test((method Pack "a","b","c"), "method,a,b,c"); +is(Pack->method("a","b","c"), "method,a,b,c"); +is(Pack->$mname("a","b","c"), "method,a,b,c"); +is(method Pack ("a","b","c"), "method,a,b,c"); +is((method Pack "a","b","c"), "method,a,b,c"); -test(Pack->method(), "method"); -test(Pack->$mname(), "method"); -test(method Pack (), "method"); -test(Pack->method, "method"); -test(Pack->$mname, "method"); -test(method Pack, "method"); +is(Pack->method(), "method"); +is(Pack->$mname(), "method"); +is(method Pack (), "method"); +is(Pack->method, "method"); +is(Pack->$mname, "method"); +is(method Pack, "method"); -test($obj->method("a","b","c"), "method,a,b,c"); -test($obj->$mname("a","b","c"), "method,a,b,c"); -test((method $obj ("a","b","c")), "method,a,b,c"); -test((method $obj "a","b","c"), "method,a,b,c"); +is($obj->method("a","b","c"), "method,a,b,c"); +is($obj->$mname("a","b","c"), "method,a,b,c"); +is((method $obj ("a","b","c")), "method,a,b,c"); +is((method $obj "a","b","c"), "method,a,b,c"); -test($obj->method(0), "method,0"); -test($obj->method(1), "method,1"); +is($obj->method(0), "method,0"); +is($obj->method(1), "method,1"); -test($obj->method(), "method"); -test($obj->$mname(), "method"); -test((method $obj ()), "method"); -test($obj->method, "method"); -test($obj->$mname, "method"); -test(method $obj, "method"); +is($obj->method(), "method"); +is($obj->$mname(), "method"); +is((method $obj ()), "method"); +is($obj->method, "method"); +is($obj->$mname, "method"); +is(method $obj, "method"); -test( A->d, "C::d"); # Update hash table; +is( A->d, "C::d"); # Update hash table; *B::d = \&D::d; # Import now. -test (A->d, "D::d"); # Update hash table; +is(A->d, "D::d"); # Update hash table; { local @A::ISA = qw(C); # Update hash table with split() assignment - test (A->d, "C::d"); + is(A->d, "C::d"); $#A::ISA = -1; - test (eval { A->d } || "fail", "fail"); + is(eval { A->d } || "fail", "fail"); } -test (A->d, "D::d"); +is(A->d, "D::d"); { local *B::d; eval 'sub B::d {"B::d1"}'; # Import now. - test (A->d, "B::d1"); # Update hash table; + is(A->d, "B::d1"); # Update hash table; undef &B::d; - test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1); + is((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1); } -test (A->d, "D::d"); # Back to previous state +is(A->d, "D::d"); # Back to previous state eval 'sub B::d {"B::d2"}'; # Import now. -test (A->d, "B::d2"); # Update hash table; +is(A->d, "B::d2"); # Update hash table; # What follows is hardly guarantied to work, since the names in scripts # are already linked to "pruned" globs. Say, `undef &B::d' if it were @@ -88,30 +82,30 @@ test (A->d, "B::d2"); # Update hash table; undef &B::d; delete $B::{d}; -test (A->d, "C::d"); # Update hash table; +is(A->d, "C::d"); # Update hash table; eval 'sub B::d {"B::d3"}'; # Import now. -test (A->d, "B::d3"); # Update hash table; +is(A->d, "B::d3"); # Update hash table; delete $B::{d}; *dummy::dummy = sub {}; # Mark as updated -test (A->d, "C::d"); +is(A->d, "C::d"); eval 'sub B::d {"B::d4"}'; # Import now. -test (A->d, "B::d4"); # Update hash table; +is(A->d, "B::d4"); # Update hash table; delete $B::{d}; # Should work without any help too -test (A->d, "C::d"); +is(A->d, "C::d"); { local *C::d; - test (eval { A->d } || "nope", "nope"); + is(eval { A->d } || "nope", "nope"); } -test (A->d, "C::d"); +is(A->d, "C::d"); *A::x = *A::d; # See if cache incorrectly follows synonyms A->d; -test (eval { A->x } || "nope", "nope"); +is(eval { A->x } || "nope", "nope"); eval <<'EOF'; sub C::e; @@ -138,14 +132,14 @@ sub C::AUTOLOAD { } EOF -test(A->e(), "C: In C::e, 1"); # We get a correct autoload -test(A->e(), "C: In C::e, 1"); # Which sticks +is(A->e(), "C: In C::e, 1"); # We get a correct autoload +is(A->e(), "C: In C::e, 1"); # Which sticks -test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top -test(A->ee(), "B: In A::ee, 2"); # Which sticks +is(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top +is(A->ee(), "B: In A::ee, 2"); # Which sticks -test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method -test(Y->f(), "B: In Y::f, 3"); # Which sticks +is(Y->f(), "B: In Y::f, 3"); # We vivify a correct method +is(Y->f(), "B: In Y::f, 3"); # Which sticks # This test is not intended to be reasonable. It is here just to let you # know that you broke some old construction. Feel free to rewrite the test @@ -158,11 +152,11 @@ test(Y->f(), "B: In Y::f, 3"); # Which sticks goto &$AUTOLOAD; }; -test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload -test(A->eee(), "new B: In A::eee, 4"); # Which sticks +is(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload +is(A->eee(), "new B: In A::eee, 4"); # Which sticks # this test added due to bug discovery -test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); +is(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); # test that failed subroutine calls don't affect method calls { @@ -171,9 +165,9 @@ test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); package A2; @ISA = 'A1'; package main; - test(A2->foo(), "foo"); - test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1); - test(A2->foo(), "foo"); + is(A2->foo(), "foo"); + is(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1); + is(A2->foo(), "foo"); } ## This test was totally misguided. It passed before only because the @@ -181,56 +175,56 @@ test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); ## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just ## happens to export %Config. # { -# test(do { use Config; eval 'Config->foo()'; +# is(do { use Config; eval 'Config->foo()'; # $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); -# test(do { use Config; eval '$d = bless {}, "Config"; $d->foo()'; +# is(do { use Config; eval '$d = bless {}, "Config"; $d->foo()'; # $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); # } # test error messages if method loading fails -test(do { eval '$e = bless {}, "E::A"; E::A->foo()'; +is(do { eval '$e = bless {}, "E::A"; E::A->foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::A" at/ ? 1 : $@}, 1); -test(do { eval '$e = bless {}, "E::B"; $e->foo()'; +is(do { eval '$e = bless {}, "E::B"; $e->foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::B" at/ ? 1 : $@}, 1); -test(do { eval 'E::C->foo()'; +is(do { eval 'E::C->foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::C" (perhaps / ? 1 : $@}, 1); -test(do { eval 'UNIVERSAL->E::D::foo()'; +is(do { eval 'UNIVERSAL->E::D::foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::D" (perhaps / ? 1 : $@}, 1); -test(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()'; +is(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::E" (perhaps / ? 1 : $@}, 1); $e = bless {}, "E::F"; # force package to exist -test(do { eval 'UNIVERSAL->E::F::foo()'; +is(do { eval 'UNIVERSAL->E::F::foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1); -test(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()'; +is(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()'; $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1); # TODO: we need some tests for the SUPER:: pseudoclass # failed method call or UNIVERSAL::can() should not autovivify packages -test( $::{"Foo::"} || "none", "none"); # sanity check 1 -test( $::{"Foo::"} || "none", "none"); # sanity check 2 +is( $::{"Foo::"} || "none", "none"); # sanity check 1 +is( $::{"Foo::"} || "none", "none"); # sanity check 2 -test( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" ); -test( $::{"Foo::"} || "none", "none"); # still missing? +is( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" ); +is( $::{"Foo::"} || "none", "none"); # still missing? -test( Foo->UNIVERSAL::can("boogie") ? "yes":"no", "no" ); -test( $::{"Foo::"} || "none", "none"); # still missing? +is( Foo->UNIVERSAL::can("boogie") ? "yes":"no", "no" ); +is( $::{"Foo::"} || "none", "none"); # still missing? -test( Foo->can("boogie") ? "yes":"no", "no" ); -test( $::{"Foo::"} || "none", "none"); # still missing? +is( Foo->can("boogie") ? "yes":"no", "no" ); +is( $::{"Foo::"} || "none", "none"); # still missing? -test( eval 'Foo->boogie(); 1' ? "yes":"no", "no" ); -test( $::{"Foo::"} || "none", "none"); # still missing? +is( eval 'Foo->boogie(); 1' ? "yes":"no", "no" ); +is( $::{"Foo::"} || "none", "none"); # still missing? -test(do { eval 'Foo->boogie()'; +is(do { eval 'Foo->boogie()'; $@ =~ /^\QCan't locate object method "boogie" via package "Foo" (perhaps / ? 1 : $@}, 1); eval 'sub Foo::boogie { "yes, sir!" }'; -test( $::{"Foo::"} ? "ok" : "none", "ok"); # should exist now -test( Foo->boogie(), "yes, sir!"); +is( $::{"Foo::"} ? "ok" : "none", "ok"); # should exist now +is( Foo->boogie(), "yes, sir!"); # TODO: universal.t should test NoSuchPackage->isa()/can() @@ -238,10 +232,10 @@ test( Foo->boogie(), "yes, sir!"); # print foo("bar") where foo does not exist is not an indirect object. # print foo "bar" where foo does not exist is an indirect object. eval { sub AUTOLOAD { "ok ", shift, "\n"; } }; -print nonsuch(++$cnt); +ok(1); # Bug ID 20010902.002 -test ( +is( eval q[ $x = 'x'; sub Foo::x : lvalue { $x } @@ -262,7 +256,6 @@ test ( @AutoDest::ISA = qw(AutoDest::Base); { my $x = bless {}, 'AutoDest'; } $w =~ s/\n//g; - test($w, ''); + is($w, ''); } -print "# $cnt tests completed\n";