X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fmethod.t;h=4e4ac97c19280fc440c417d8884f0c711455e3af;hb=a4c04bdcc508b6a45f83e703d0f82401445aa55b;hp=f1b1888ef649f98e00debdc70584dcfc856ef35b;hpb=fae75791d47423cf8816d13f7030c34cfdb1c512;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/method.t b/t/op/method.t
index f1b1888..4e4ac97 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -4,7 +4,12 @@
 # test method calls and autoloading.
 #
 
-print "1..26\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..72\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -19,6 +24,38 @@ sub test {
   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");
+
+test(Pack->method(), "method");
+test(Pack->$mname(), "method");
+test(method Pack (), "method");
+test(Pack->method, "method");
+test(Pack->$mname, "method");
+test(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");
+
+test($obj->method(0), "method,0");
+test($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");
+
 test( A->d, "C::d");		# Update hash table;
 
 *B::d = \&D::d;			# Import now.
@@ -126,3 +163,81 @@ test(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");
+
+# test that failed subroutine calls don't affect method calls
+{
+    package A1;
+    sub foo { "foo" }
+    package A2;
+    @ISA = 'A1';
+    package main;
+    test(A2->foo(), "foo");
+    test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
+    test(A2->foo(), "foo");
+}
+
+## This test was totally misguided.  It passed before only because the
+## code to determine if a package was loaded used to look for the hash
+## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just
+## happens to export %Config.
+#  {
+#      test(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()';
+#  	      $@ =~ /^\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()';
+	  $@ =~ /^\QCan't locate object method "foo" via package "E::A" at/ ? 1 : $@}, 1);
+test(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()';
+	  $@ =~ /^\QCan't locate object method "foo" via package "E::C" (perhaps / ? 1 : $@}, 1);
+
+test(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()';
+	  $@ =~ /^\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()';
+	  $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
+test(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
+
+test( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" );
+test( $::{"Foo::"} || "none", "none");  # still missing?
+
+test( Foo->UNIVERSAL::can("boogie")   ? "yes":"no", "no" );
+test( $::{"Foo::"} || "none", "none");  # still missing?
+
+test( Foo->can("boogie")              ? "yes":"no", "no" );
+test( $::{"Foo::"} || "none", "none");  # still missing?
+
+test( eval 'Foo->boogie(); 1'         ? "yes":"no", "no" );
+test( $::{"Foo::"} || "none", "none");  # still missing?
+
+test(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!");
+
+# TODO: universal.t should test NoSuchPackage->isa()/can()
+
+# This is actually testing parsing of indirect objects and undefined subs
+#   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);
+
+print "# $cnt tests completed\n";