Remove caveats about RT#69939
gfx [Sat, 27 Mar 2010 06:42:13 +0000 (15:42 +0900)]
caveats/RT69939.t [deleted file]
lib/Mouse.pm
t/900_bug/006_RT69939t [new file with mode: 0644]

diff --git a/caveats/RT69939.t b/caveats/RT69939.t
deleted file mode 100644 (file)
index c13fb69..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-#!perl -w
-# See the CAVEATS section in Mouse.pm
-use strict;
-use Test::More;
-
-{
-    package Class;
-    use Mouse;
-
-    has foo => (
-        is  => 'rw',
-
-        default => sub{
-            # Ticket #69939
-            # See the Mouse manpage
-
-            #eval       'BEGIN{ die }';   # NG
-            eval{ eval 'BEGIN{ die }' }; # OK
-            ::pass 'in a default callback';
-        },
-    );
-}
-
-pass "class definition has been done";
-
-isa_ok(Class->new, 'Class');
-
-done_testing;
-
index 0d6aa8b..7364999 100644 (file)
@@ -400,22 +400,6 @@ You may use L</extends> to replace the superclass list.
 Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
 keywords (such as L</extends>) it will break loudly instead breaking subtly.
 
-=head1 CAVEATS
-
-If you use Mouse::XS you might see a fatal error on callbacks
-which include C<eval 'BEGIN{ die }'>, which typically occurs in such code
-as C<eval 'use NotInstalledModule'>. This is not
-a bug in Mouse. In fact, it is a bug in Perl (RT #69939).
-
-To work around this problem, surround C<eval STRING> with C<eval BLOCK>:
-
-    sub callback {
-        # eval 'use NotInstalledModule';       # NG
-        eval{ eval 'use NotInstalledModule' }; # OK
-    }
-
-It seems ridiculous, but it works as you expected.
-
 =head1 SOURCE CODE ACCESS
 
 We have a public git repository:
diff --git a/t/900_bug/006_RT69939t b/t/900_bug/006_RT69939t
new file mode 100644 (file)
index 0000000..680dee8
--- /dev/null
@@ -0,0 +1,38 @@
+#!perl -w
+
+package Foo;
+use Mouse;
+
+has bar => (
+    is => 'rw',
+
+    trigger => sub {
+        eval 'BEGIN{ die }';
+    },
+    default => sub {
+        eval 'BEGIN{ die }';
+        return 42;
+    },
+);
+
+sub BUILDARGS {
+    eval 'BEGIN{ die }';
+    return {};
+}
+
+sub BUILD {
+    eval 'BEGIN{ die }';
+}
+
+package main;
+
+use Test::More tests => 3;
+
+$@ = '(ERRSV)';
+
+my $foo = Foo->new;
+isa_ok $foo, 'Foo';
+is $foo->bar, 42;
+$foo->bar(100);
+is $foo->bar, 100;
+note("\$@=$@");