Fix up \cX for 5.14

[perl5.git] / t / op / method.t

diff --git a/t/op/method.t b/t/op/method.t
old mode 100755 (executable)
new mode 100644 (file)
index 52fb705..b602ca2
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -10,7 +10,7 @@ BEGIN {
     require "test.pl";
 }
 
-print "1..78\n";
+print "1..79\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -183,23 +183,23 @@ is(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
 
 
 # test error messages if method loading fails
-is(do { eval '$e = bless {}, "E::A"; E::A->foo()';
-         $@ =~ /^\QCan't locate object method "foo" via package "E::A" at/ ? 1 : $@}, 1);
-is(do { eval '$e = bless {}, "E::B"; $e->foo()';  
-         $@ =~ /^\QCan't locate object method "foo" via package "E::B" at/ ? 1 : $@}, 1);
-is(do { eval 'E::C->foo()';
-         $@ =~ /^\QCan't locate object method "foo" via package "E::C" (perhaps / ? 1 : $@}, 1);
-
-is(do { eval 'UNIVERSAL->E::D::foo()';
-         $@ =~ /^\QCan't locate object method "foo" via package "E::D" (perhaps / ? 1 : $@}, 1);
-is(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
-         $@ =~ /^\QCan't locate object method "foo" via package "E::E" (perhaps / ? 1 : $@}, 1);
+eval '$e = bless {}, "E::A"; E::A->foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::A" at/);
+eval '$e = bless {}, "E::B"; $e->foo()';  
+like ($@, qr/^\QCan't locate object method "foo" via package "E::B" at/);
+eval 'E::C->foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::C" (perhaps /);
+
+eval 'UNIVERSAL->E::D::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::D" (perhaps /);
+eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::E" (perhaps /);
 
 $e = bless {}, "E::F";  # force package to exist
-is(do { eval 'UNIVERSAL->E::F::foo()';
-         $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
-is(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
-         $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
+eval 'UNIVERSAL->E::F::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
+eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
+like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/);
 
 # TODO: we need some tests for the SUPER:: pseudoclass
 
@@ -231,7 +231,7 @@ is( Foo->boogie(), "yes, sir!");
 # 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"; } };
+eval 'sub AUTOLOAD { "ok ", shift, "\n"; }';
 ok(1);
 
 # Bug ID 20010902.002
@@ -292,3 +292,16 @@ EOT
        "check if UNIVERSAL::AUTOLOAD works",
     );
 }
+
+# Test for #71952: crash when looking for a nonexistent destructor
+# Regression introduced by fbb3ee5af3d4
+{
+    fresh_perl_is(<<'EOT',
+sub M::DESTROY; bless {}, "M" ; print "survived\n";
+EOT
+    "survived",
+    {},
+       "no crash with a declared but missing DESTROY method"
+    );
+}
+