| Subject: | Should Handle NEXT:: calls from eval { } or anonymous functions |
NEXT should be able to handle calls to NEXT:: from within eval { ... } blocks or from within anonymous function calls within the method, which at the moment it does not handle and throws an exception. This patch implements this feature.
diff -u -r -N orig/NEXT-0.60/lib/NEXT.pm fixed/NEXT-0.60/lib/NEXT.pm
--- orig/NEXT-0.60/lib/NEXT.pm 2003-08-13 06:55:41.000000000 +0300
+++ fixed/NEXT-0.60/lib/NEXT.pm 2006-01-03 16:24:57.000000000 +0200
@@ -32,7 +32,15 @@
sub AUTOLOAD
{
my ($self) = @_;
- my $caller = (caller(1))[3];
+ my $caller;
+ my $frame = 1;
+ while ((!defined($caller)) ||
+ ($caller eq "(eval)") ||
+ ($caller =~ /::__ANON__/)
+ )
+ {
+ $caller = (caller($frame++))[3];
+ }
my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD';
undef $NEXT::AUTOLOAD;
my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g;
diff -u -r -N orig/NEXT-0.60/MANIFEST fixed/NEXT-0.60/MANIFEST
--- orig/NEXT-0.60/MANIFEST 2001-11-16 02:15:47.000000000 +0200
+++ fixed/NEXT-0.60/MANIFEST 2006-01-03 16:25:46.000000000 +0200
@@ -5,6 +5,7 @@
lib/NEXT.pm
t/actual.t
t/actuns.t
+t/blocks.t
t/next.t
t/unseen.t
demo/demo.pl
@@ -12,3 +13,4 @@
demo/demo_diamond.pl
demo/demo_unseen.pl
demo/demo_unseen_actual.pl
+META.yml Module meta-data (added by MakeMaker)
diff -u -r -N orig/NEXT-0.60/META.yml fixed/NEXT-0.60/META.yml
--- orig/NEXT-0.60/META.yml 1970-01-01 02:00:00.000000000 +0200
+++ fixed/NEXT-0.60/META.yml 2006-01-03 16:25:46.000000000 +0200
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: NEXT
+version: 0.60
+version_from:
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff -u -r -N orig/NEXT-0.60/t/blocks.t fixed/NEXT-0.60/t/blocks.t
--- orig/NEXT-0.60/t/blocks.t 1970-01-01 02:00:00.000000000 +0200
+++ fixed/NEXT-0.60/t/blocks.t 2006-01-03 16:22:51.000000000 +0200
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use NEXT;
+
+package One;
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless $self, $class;
+ $self->_initialize(@_);
+ return $self;
+}
+
+sub _initialize
+{
+}
+
+sub hello
+{
+ return "hello";
+}
+
+package Two;
+
+sub hello
+{
+ my $self = shift;
+ my $ret;
+ eval {
+ $ret = $self->NEXT::hello();
+ };
+ return $ret;
+}
+
+package TwoApp;
+
+use vars qw(@ISA);
+
+@ISA=(qw(Two One));
+
+package Three;
+
+sub hello
+{
+ my $self = shift;
+
+ my $ret;
+ my $mysub = sub {
+ $ret = $self->NEXT::hello();
+ };
+
+ eval {
+ $mysub->();
+ };
+ return $ret;
+}
+
+package ThreeApp;
+
+use vars qw(@ISA);
+
+@ISA=(qw(Three One));
+
+package main;
+
+use Test::More tests => 2;
+
+{
+ my $obj = TwoApp->new();
+ # TEST
+ is ($obj->hello(), "hello", "NEXT operates for eval { } blocks");
+}
+{
+ my $obj = ThreeApp->new();
+ # TEST
+ is ($obj->hello(), "hello", "NEXT operates for eval { } blocks");
+}
+