Hello community,
here is the log from the commit of package perl-Contextual-Return for
openSUSE:Factory checked in at 2012-02-28 14:14:38
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Contextual-Return (Old)
and /work/SRC/openSUSE:Factory/.perl-Contextual-Return.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Contextual-Return", Maintainer is ""
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Contextual-Return/perl-Contextual-Return.changes
2011-09-23 12:36:29.000000000 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Contextual-Return.new/perl-Contextual-Return.changes
2012-02-28 14:14:45.000000000 +0100
@@ -1,0 +2,19 @@
+Mon Feb 27 08:47:34 UTC 2012 - co...@suse.com
+
+- updated to 0.004001
+
+ - Updated version number of Contextual::Return::Failure
+ to placate CPAN indexer
+
+ - Improved error messages for bare handlers in bad contexts (thanks Mathew)
+
+ - Work around problems with Test::More and caller
+
+ - Fixed context propagation bugs in FIXED and ACTIVE modifiers
+
+ - Added STRICT modifier to prevent fallbacks
+ (i.e. impose strict typing on return values)
+
+ - Fixed annoying POD nit (thanks Salvatore)
+
+-------------------------------------------------------------------
Old:
----
Contextual-Return-0.003001.tar.gz
New:
----
Contextual-Return-0.004001.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Contextual-Return.spec ++++++
--- /var/tmp/diff_new_pack.OiHZZn/_old 2012-02-28 14:14:46.000000000 +0100
+++ /var/tmp/diff_new_pack.OiHZZn/_new 2012-02-28 14:14:46.000000000 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Contextual-Return
#
-# Copyright (c) 2011 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2012 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -16,25 +16,26 @@
#
-
Name: perl-Contextual-Return
-Version: 0.003001
-Release: 1
-License: GPL-1.0+ or Artistic-1.0
+Version: 0.004001
+Release: 0
%define cpan_name Contextual-Return
Summary: Create context-senstive return values
-Url: http://search.cpan.org/dist/Contextual-Return/
+License: GPL-1.0+ or Artistic-1.0
Group: Development/Libraries/Perl
+Url: http://search.cpan.org/dist/Contextual-Return/
Source:
http://www.cpan.org/authors/id/D/DC/DCONWAY/%{cpan_name}-%{version}.tar.gz
BuildArch: noarch
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
BuildRequires: perl(Module::Build)
-BuildRequires: perl(version)
BuildRequires: perl(Want)
-Requires: perl(version)
+BuildRequires: perl(version)
+#BuildRequires: perl(Contextual::Return)
+#BuildRequires: perl(Contextual::Return::Failure)
Requires: perl(Want)
+Requires: perl(version)
%{perl_requires}
%description
@@ -99,9 +100,6 @@
./Build install destdir=%{buildroot} create_packlist=0
%perl_gen_filelist
-%clean
-%{__rm} -rf %{buildroot}
-
%files -f %{name}.files
%defattr(-,root,root,755)
%doc Changes README
++++++ Contextual-Return-0.003001.tar.gz -> Contextual-Return-0.004001.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/Changes
new/Contextual-Return-0.004001/Changes
--- old/Contextual-Return-0.003001/Changes 2010-06-22 23:20:36.000000000
+0200
+++ new/Contextual-Return-0.004001/Changes 2012-02-16 09:01:05.000000000
+0100
@@ -78,3 +78,26 @@
under the debugger (thanks Steven)
- Documented METHOD handlers
+
+
+0.003002 Thu Jan 19 09:27:29 2012
+
+ - Updated version number of Contextual::Return::Failure
+ to placate CPAN indexer
+
+ - Improved error messages for bare handlers in bad contexts (thanks Mathew)
+
+ - Work around problems with Test::More and caller
+
+
+0.004000 Thu Feb 16 14:30:56 2012
+
+ - Fixed context propagation bugs in FIXED and ACTIVE modifiers
+
+ - Added STRICT modifier to prevent fallbacks
+ (i.e. impose strict typing on return values)
+
+
+0.004001 Thu Feb 16 19:01:05 2012
+
+ - Fixed annoying POD nit (thanks Salvatore)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/MANIFEST
new/Contextual-Return-0.004001/MANIFEST
--- old/Contextual-Return-0.003001/MANIFEST 2010-06-22 23:20:38.000000000
+0200
+++ new/Contextual-Return-0.004001/MANIFEST 2012-02-16 09:01:07.000000000
+0100
@@ -14,7 +14,6 @@
t/interp.t
t/nonvoid.t
t/object.t
-t/pod-coverage.t
t/pod.t
t/simple.t
t/fail_with.t
@@ -37,3 +36,5 @@
t/simple_prefix.t
t/simple_rename.t
t/try
+t/STRICT.t
+META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/META.json
new/Contextual-Return-0.004001/META.json
--- old/Contextual-Return-0.003001/META.json 1970-01-01 01:00:00.000000000
+0100
+++ new/Contextual-Return-0.004001/META.json 2012-02-16 09:01:07.000000000
+0100
@@ -0,0 +1,43 @@
+{
+ "abstract" : "Create context-senstive return values",
+ "author" : [
+ "Damian Conway <dcon...@cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter
version 2.112150",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
+ "version" : "2"
+ },
+ "name" : "Contextual-Return",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : 0
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : 0
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Test::More" : 0,
+ "Want" : 0,
+ "version" : 0
+ }
+ }
+ },
+ "release_status" : "stable",
+ "version" : "0.004001"
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/META.yml
new/Contextual-Return-0.004001/META.yml
--- old/Contextual-Return-0.003001/META.yml 2010-06-22 23:20:40.000000000
+0200
+++ new/Contextual-Return-0.004001/META.yml 2012-02-16 09:01:07.000000000
+0100
@@ -1,16 +1,24 @@
---- #YAML:1.0
-name: Contextual-Return
-version: 0.003001
-abstract: Create context-senstive return values
-license: ~
-author:
- - Damian Conway <dcon...@cpan.org>
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- Test::More: 0
- version: 0
- Want: 0
+---
+abstract: 'Create context-senstive return values'
+author:
+ - 'Damian Conway <dcon...@cpan.org>'
+build_requires:
+ ExtUtils::MakeMaker: 0
+configure_requires:
+ ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version
2.112150'
+license: unknown
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Contextual-Return
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ Test::More: 0
+ Want: 0
+ version: 0
+version: 0.004001
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/README
new/Contextual-Return-0.004001/README
--- old/Contextual-Return-0.003001/README 2010-06-22 23:20:36.000000000
+0200
+++ new/Contextual-Return-0.004001/README 2012-02-16 09:01:05.000000000
+0100
@@ -1,4 +1,4 @@
-Contextual::Return version 0.003001
+Contextual::Return version 0.004001
This module provides a collection of named blocks that allow a return
statement to return different values depending on the context in which it's
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Contextual-Return-0.003001/lib/Contextual/Return/Failure.pm
new/Contextual-Return-0.004001/lib/Contextual/Return/Failure.pm
--- old/Contextual-Return-0.003001/lib/Contextual/Return/Failure.pm
2009-04-30 01:56:49.000000000 +0200
+++ new/Contextual-Return-0.004001/lib/Contextual/Return/Failure.pm
2010-10-04 06:30:30.000000000 +0200
@@ -1,5 +1,5 @@
package Contextual::Return::Failure;
-#use version; $VERSION = qv('0.0.2');
+our $VERSION = 0.000_003;
use Contextual::Return;
BEGIN { *_in_context = *Contextual::Return::_in_context }
@@ -110,6 +110,9 @@
die _in_context $exception, "Attempted to use failure value"
}
}
+ METHOD {
+ error => sub { _in_context $exception }
+ }
}
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/lib/Contextual/Return.pm
new/Contextual-Return-0.004001/lib/Contextual/Return.pm
--- old/Contextual-Return-0.003001/lib/Contextual/Return.pm 2010-06-22
23:20:36.000000000 +0200
+++ new/Contextual-Return-0.004001/lib/Contextual/Return.pm 2012-02-16
09:01:05.000000000 +0100
@@ -4,11 +4,19 @@
BEGIN {
no warnings 'redefine';
+ my $fallback_caller = *CORE::GLOBAL::caller{CODE};
*CORE::GLOBAL::caller = sub {
my ($uplevels) = shift || 0;
- return CORE::caller($uplevels + 2 + $Contextual::Return::uplevel)
- if $Contextual::Return::uplevel;
- return CORE::caller($uplevels + 1);
+ if ($fallback_caller) {
+ return $fallback_caller->($uplevels + 2 +
$Contextual::Return::uplevel)
+ if $Contextual::Return::uplevel;
+ return $fallback_caller->($uplevels + 1);
+ }
+ else {
+ return CORE::caller($uplevels + 2 + $Contextual::Return::uplevel)
+ if $Contextual::Return::uplevel;
+ return CORE::caller($uplevels + 1);
+ }
};
use Carp;
@@ -27,7 +35,7 @@
}
-our $VERSION = '0.003001';
+our $VERSION = '0.004001';
use warnings;
use strict;
@@ -48,7 +56,7 @@
my ($package, $file, $line, $sub) = CORE::caller($stack_frame++);
# Fall off the top of the stack...
- last if !defined $package;
+ last STACK_FRAME if !defined $package;
# Ignore this module (and any helpers)...
next STACK_FRAME if $package =~ m{^Contextual::Return}xms;
@@ -99,7 +107,7 @@
qw(
LAZY RESULT RVALUE METHOD FAIL
FIXED RECOVER LVALUE RETOBJ FAIL_WITH
- ACTIVE CLEANUP NVALUE
+ ACTIVE CLEANUP NVALUE STRICT
)
);
@@ -259,16 +267,115 @@
}
}
-sub FIXED ($) {
- my ($crv) = @_;
- $attrs_of{refaddr $crv}{FIXED} = 1;
- return $crv;
-}
+for my $modifier_name (qw< STRICT FIXED ACTIVE >) {
+ no strict 'refs';
+ *{$modifier_name} = sub ($) {
+ my ($crv) = @_;
+ my $attrs = $attrs_of{refaddr $crv};
-sub ACTIVE ($) {
- my ($crv) = @_;
- $attrs_of{refaddr $crv}{ACTIVE} = 1;
- return $crv;
+ # Track context...
+ my $wantarray = wantarray;
+ use Want;
+ $attrs->{want_pure_bool} ||= Want::want('BOOL');
+
+ # Remember the modification...
+ $attrs->{$modifier_name} = 1;
+
+ # Prepare for exception handling...
+ my $recover = $attrs->{RECOVER};
+ local $Contextual::Return::uplevel = 2;
+
+ # Handle list context directly, if possible...
+ if ($wantarray) {
+ local $Contextual::Return::__RESULT__;
+ # List or ancestral handlers...
+ handler:
+ for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
+
+ my @rv = eval { $handler->(@{$attrs->{args}}) };
+ if ($recover) {
+ if (!$Contextual::Return::__RESULT__) {
+ $Contextual::Return::__RESULT__ = [@rv];
+ }
+ () = $recover->(@{$attrs->{args}});
+ }
+ elsif ($@) {
+ die $@;
+ }
+
+ return @rv if !$Contextual::Return::__RESULT__;
+ return @{$Contextual::Return::__RESULT__};
+ }
+ # Convert to list from arrayref handler...
+ if (!$attrs->{STRICT} and my $handler = $attrs->{ARRAYREF}) {
+ my $array_ref = eval { $handler->(@{$attrs->{args}}) };
+
+ if ($recover) {
+ if (!$Contextual::Return::__RESULT__) {
+ $Contextual::Return::__RESULT__ = [$array_ref];
+ }
+ scalar $recover->(@{$attrs->{args}});
+ }
+ elsif ($@) {
+ die $@;
+ }
+
+ # Array ref may be returned directly, or via RESULT{}...
+ $array_ref = $Contextual::Return::__RESULT__->[0]
+ if $Contextual::Return::__RESULT__;
+
+ return @{$array_ref} if (ref $array_ref||q{}) eq 'ARRAY';
+ }
+ # Return scalar object as one-elem list, if possible...
+ handler:
+ for my $context (qw(BOOL STR NUM VALUE SCALAR LAZY)) {
+ last handler if $attrs->{STRICT};
+ return $crv if exists $attrs->{$context};
+ }
+ $@ = _in_context "Can't call $attrs->{sub} in a list context";
+ if ($recover) {
+ () = $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
+ }
+
+ # Handle void context directly...
+ if (!defined $wantarray) {
+ handler:
+ for my $context (qw< VOID DEFAULT >) {
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
+
+ eval { $attrs->{$context}->(@{$attrs->{args}}) };
+ if ($recover) {
+ $recover->(@{$attrs->{args}});
+ }
+ elsif ($@) {
+ die $@;
+ }
+ last handler;
+ }
+ if ($attrs->{STRICT}) {
+ $@ = _in_context "Can't call $attrs->{sub} in a void context";
+ if ($recover) {
+ () = $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
+ }
+ return;
+ }
+
+ # Otherwise, let someone else handle it...
+ return $crv;
+ }
}
sub LIST (;&$) {
@@ -282,6 +389,9 @@
if (!refaddr $crv) {
my $args = do{ package DB; ()=CORE::caller(1); \@DB::args };
my $subname = (CORE::caller(1))[3];
+ if (!defined $subname) {
+ $subname = 'bare LIST {...}';
+ }
$crv = bless \my $scalar, 'Contextual::Return::Value';
$attrs = $attrs_of{refaddr $crv} = { args => $args, sub => $subname };
}
@@ -304,7 +414,7 @@
local $Contextual::Return::uplevel = 2;
# Handle list context directly...
- if (wantarray) {
+ if ($wantarray) {
local $Contextual::Return::__RESULT__;
my @rv = eval { $block->(@{$attrs->{args}}) };
@@ -326,7 +436,9 @@
if (!defined $wantarray) {
handler:
for my $context (qw< VOID DEFAULT >) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
eval { $attrs->{$context}->(@{$attrs->{args}}) };
if ($recover) {
@@ -335,7 +447,16 @@
elsif ($@) {
die $@;
}
- last;
+ last handler;
+ }
+ if ($attrs->{STRICT}) {
+ $@ = _in_context "Can't call $attrs->{sub} in a void context";
+ if ($recover) {
+ () = $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
}
return;
}
@@ -357,6 +478,9 @@
if (!refaddr $crv) {
my $args = do{ package DB; ()=CORE::caller(1); \@DB::args };
my $subname = (CORE::caller(1))[3];
+ if (!defined $subname) {
+ $subname = 'bare VOID {...}';
+ }
$crv = bless \my $scalar, 'Contextual::Return::Value';
$attrs = $attrs_of{refaddr $crv} = { args => $args, sub => $subname };
}
@@ -379,12 +503,14 @@
local $Contextual::Return::uplevel = 2;
# Handle list context directly, if possible...
- if (wantarray) {
+ if ($wantarray) {
local $Contextual::Return::__RESULT__;
# List or ancestral handlers...
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
my @rv = eval { $handler->(@{$attrs->{args}}) };
if ($recover) {
@@ -401,7 +527,7 @@
return @{$Contextual::Return::__RESULT__};
}
# Convert to list from arrayref handler...
- if (my $handler = $attrs->{ARRAYREF}) {
+ if (!$attrs->{STRICT} and my $handler = $attrs->{ARRAYREF}) {
my $array_ref = eval { $handler->(@{$attrs->{args}}) };
if ($recover) {
@@ -423,9 +549,10 @@
# Return scalar object as one-elem list, if possible...
handler:
for my $context (qw(BOOL STR NUM VALUE SCALAR LAZY)) {
+ last handler if $attrs->{STRICT};
return $crv if exists $attrs->{$context};
}
- $@ = _in_context "Can't call $attrs->{sub} in list context";
+ $@ = _in_context "Can't call $attrs->{sub} in a list context";
if ($recover) {
() = $recover->(@{$attrs->{args}});
}
@@ -470,6 +597,9 @@
if (!refaddr $crv) {
my $args = do{ package DB; ()=CORE::caller(1); \@DB::args };
my $subname = (CORE::caller(1))[3];
+ if (!defined $subname) {
+ $subname = "bare $context {...}";
+ }
$crv = bless \my $scalar, 'Contextual::Return::Value';
$attrs = $attrs_of{refaddr $crv}
= { args => $args, sub => $subname };
@@ -486,7 +616,7 @@
# Identify contexts...
my $wantarray = wantarray;
- use Want;
+ use Want ();
$attrs->{want_pure_bool} ||= Want::want('BOOL');
# Prepare for exception handling...
@@ -494,13 +624,15 @@
local $Contextual::Return::uplevel = 2;
# Handle list context directly, if possible...
- if (wantarray) {
+ if ($wantarray) {
local $Contextual::Return::__RESULT__;
# List or ancestral handlers...
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
my @rv = eval { $handler->(@{$attrs->{args}}) };
if ($recover) {
@@ -517,7 +649,7 @@
return @{$Contextual::Return::__RESULT__};
}
# Convert to list from arrayref handler...
- if (my $handler = $attrs->{ARRAYREF}) {
+ if (!$attrs->{STRICT} and my $handler = $attrs->{ARRAYREF}) {
my $array_ref = eval { $handler->(@{$attrs->{args}}) };
if ($recover) {
@@ -539,16 +671,19 @@
# Return scalar object as one-elem list, if possible...
handler:
for my $context (qw(BOOL STR NUM VALUE SCALAR LAZY)) {
+ last if $attrs->{STRICT};
return $crv if exists $attrs->{$context};
}
- die _in_context "Can't call $attrs->{sub} in list context";
+ die _in_context "Can't call $attrs->{sub} in a list context";
}
# Handle void context directly...
if (!defined $wantarray) {
handler:
for my $context (qw< VOID DEFAULT >) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
eval { $handler->(@{$attrs->{args}}) };
if ($recover) {
@@ -558,7 +693,16 @@
die $@;
}
- last;
+ last handler;
+ }
+ if ($attrs->{STRICT}) {
+ $@ = _in_context "Can't call $attrs->{sub} in a void context";
+ if ($recover) {
+ () = $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
}
return;
}
@@ -568,11 +712,12 @@
}
}
+handler:
for my $context_name (@CONTEXTS, qw< RECOVER _internal_LIST CLEANUP >) {
- next if $context_name eq 'LIST' # These
- || $context_name eq 'VOID' # four
- || $context_name eq 'SCALAR' # handled
- || $context_name eq 'NONVOID'; # separately
+ next handler if $context_name eq 'LIST' # These
+ || $context_name eq 'VOID' # four
+ || $context_name eq 'SCALAR' # handled
+ || $context_name eq 'NONVOID'; # separately
no strict qw( refs );
*{$context_name} = sub (&;$) {
@@ -583,6 +728,9 @@
if (!refaddr $crv) {
my $args = do{ package DB; ()=CORE::caller(1); \@DB::args };
my $subname = (CORE::caller(1))[3];
+ if (!defined $subname) {
+ $subname = "bare $context_name {...}";
+ }
$crv = bless \my $scalar, 'Contextual::Return::Value';
$attrs = $attrs_of{refaddr $crv}
= { args => $args, sub => $subname };
@@ -601,7 +749,7 @@
# Identify contexts...
my $wantarray = wantarray;
- use Want;
+ use Want ();
$attrs->{want_pure_bool} ||= Want::want('BOOL');
# Prepare for exception handling...
@@ -609,7 +757,7 @@
local $Contextual::Return::uplevel = 2;
# Handle list context directly, if possible...
- if (wantarray) {
+ if ($wantarray) {
local $Contextual::Return::__RESULT__
= $context_name eq 'RECOVER' ? $Contextual::Return::__RESULT__
: undef
@@ -618,7 +766,9 @@
# List or ancestral handlers...
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
my @rv = eval { $handler->(@{$attrs->{args}}) };
if ($recover) {
@@ -635,7 +785,7 @@
return @{$Contextual::Return::__RESULT__};
}
# Convert to list from arrayref handler...
- if (my $handler = $attrs->{ARRAYREF}) {
+ if (!$attrs->{STRICT} and my $handler = $attrs->{ARRAYREF}) {
local $Contextual::Return::uplevel = 2;
# Array ref may be returned directly, or via RESULT{}...
@@ -658,9 +808,10 @@
# Return scalar object as one-elem list, if possible...
handler:
for my $context (qw(BOOL STR NUM VALUE SCALAR LAZY)) {
+ last if $attrs->{STRICT};
return $crv if exists $attrs->{$context};
}
- $@ = _in_context "Can't call $attrs->{sub} in list context";
+ $@ = _in_context "Can't call $attrs->{sub} in a list context";
if ($recover) {
() = $recover->(@{$attrs->{args}});
}
@@ -673,7 +824,10 @@
if (!defined $wantarray) {
handler:
for my $context (qw(VOID DEFAULT)) {
- next if !$attrs->{$context};
+ if (!$attrs->{$context}) {
+ last handler if $attrs->{STRICT};
+ next handler;
+ }
eval { $attrs->{$context}->(@{$attrs->{args}}) };
@@ -684,7 +838,16 @@
die $@;
}
- last;
+ last handler;
+ }
+ if ($attrs->{STRICT}) {
+ $@ = _in_context "Can't call $attrs->{sub} in a void context";
+ if ($recover) {
+ () = $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
}
return;
}
@@ -823,7 +986,9 @@
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(STR SCALAR LAZY VALUE NONVOID DEFAULT NUM)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -851,7 +1016,7 @@
}
return $rv;
}
- $@ = _in_context "Can't call $attrs->{sub} in string context";
+ $@ = _in_context "Can't use return value of $attrs->{sub} as a
string";
if (my $recover = $attrs->{RECOVER}) {
scalar $recover->(@{$attrs->{args}});
}
@@ -866,7 +1031,9 @@
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(NUM SCALAR LAZY VALUE NONVOID DEFAULT STR)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -894,7 +1061,7 @@
}
return $rv;
}
- $@ = _in_context "Can't call $attrs->{sub} in numeric context";
+ $@ = _in_context "Can't use return value of $attrs->{sub} as a
number";
if (my $recover = $attrs->{RECOVER}) {
scalar $recover->(@{$attrs->{args}});
}
@@ -913,8 +1080,10 @@
$attrs->{want_pure_bool} = 0;
handler:
- for my $context (@PUREBOOL, qw(BOOL SCALAR LAZY VALUE NONVOID
DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ for my $context (@PUREBOOL, qw(BOOL STR NUM SCALAR LAZY VALUE
NONVOID DEFAULT)) {
+ my $handler = $attrs->{$context}
+ or $context eq 'BOOL' and $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -948,7 +1117,7 @@
}
return $rv;
}
- $@ = _in_context "Can't call $attrs->{sub} in boolean context";
+ $@ = _in_context "Can't use return value of $attrs->{sub} as a
boolean";
if (my $recover = $attrs->{RECOVER}) {
scalar $recover->(@{$attrs->{args}});
}
@@ -962,7 +1131,9 @@
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(SCALARREF REF NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -995,6 +1166,17 @@
}
return $rv;
}
+
+ if ($attrs->{STRICT}) {
+ $@ = _in_context "$attrs->{sub} can't return a scalar
reference";
+ if (my $recover = $attrs->{RECOVER}) {
+ scalar $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
+ }
+
if ( $attrs->{FIXED} ) {
$_[0] = \$self;
}
@@ -1007,7 +1189,9 @@
local $Contextual::Return::__RESULT__;
handler:
for my $context (qw(ARRAYREF REF)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::uplevel = 2;
my $rv = eval { $handler->(@{$attrs->{args}}) };
@@ -1041,7 +1225,9 @@
}
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ last handler if $attrs->{STRICT};
+ my $handler = $attrs->{$context}
+ or next handler;
local $Contextual::Return::uplevel = 2;
my @rv = eval { $handler->(@{$attrs->{args}}) };
@@ -1068,6 +1254,17 @@
}
return \@rv;
}
+
+ if ($attrs->{STRICT}) {
+ $@ = _in_context "$attrs->{sub} can't return an array
reference";
+ if (my $recover = $attrs->{RECOVER}) {
+ scalar $recover->(@{$attrs->{args}});
+ }
+ else {
+ die $@;
+ }
+ }
+
return [ $self ];
},
'%{}' => sub {
@@ -1076,7 +1273,9 @@
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(HASHREF REF NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -1123,7 +1322,9 @@
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(CODEREF REF NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -1170,7 +1371,9 @@
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(GLOBREF REF NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -1299,7 +1502,7 @@
if (wantarray) {
my @result = eval {
local $_ = $requested_method;
- $method_handler->(@_);
+ $method_handler->($self,@_);
};
die _in_context $@ if $@;
return @result;
@@ -1307,7 +1510,7 @@
else {
my $result = eval {
local $_ = $requested_method;
- $method_handler->(@_);
+ $method_handler->($self,@_);
};
die _in_context $@ if $@;
return $result;
@@ -1318,7 +1521,9 @@
# Next, try to create an object on which to call the method...
handler:
for my $context (qw(OBJREF STR SCALAR LAZY VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context} or next;
+ my $handler = $attrs->{$context}
+ or $attrs->{STRICT} and last handler
+ or next handler;
local $Contextual::Return::__RESULT__;
local $Contextual::Return::uplevel = 2;
@@ -1421,7 +1626,7 @@
=head1 VERSION
-This document describes Contextual::Return version 0.003001
+This document describes Contextual::Return version 0.004001
=head1 SYNOPSIS
@@ -2052,6 +2257,47 @@
(if it is also specified).
+=head3 Preventing fallbacks
+
+Sometimes fallbacks can be too helpful. Or sometimes you want to impose
+strict type checking on a return value.
+
+Contextual::Returns allows that via the C<STRICT> specifier. If you include
+C<STRICT> anywhere in your return statement, the module disables all
+fallbacks and will therefore through an exception if the return value is
+used in any way not explicitly specified in the contextual return sequence.
+
+For example, to create a subroutine that returns only a string:
+
+ sub get_name {
+ return STRICT STR { 'Bruce' }
+ }
+
+If the return value of the subroutine is used in any other way than as
+a string, an exception will be thrown.
+
+You can still specify handlers for more than a single kind of context
+when using C<STRICT>:
+
+ sub get_name {
+ return STRICT
+ STR { 'Bruce' }
+ BOOL { 0 }
+ }
+
+...but these will still be the only contexts in which the return value
+can be used:
+
+ my $n = get_name() ? 1 : 2; # Okay because BOOL handler specified
+
+ my $n = 'Dr' . get_name(); # Okay because STR handler specified
+
+ my $n = 1 + get_name(); # Exception thrown because no NUM handler
+
+In other words, C<STRICT> allows you to impose strict type checking on
+your contextual return value.
+
+
=head2 Deferring handlers
Because the various handlers form a hierarchy, it's possible to
@@ -2195,6 +2441,17 @@
No more data at demo.pl line 42
+A failure value can be interrogated for its error message, by calling its
+C<error()> method, like so:
+
+ my $val = get_next_val();
+ if ($val) {
+ print "[$val]\n";
+ }
+ else {
+ print $val->error, "\n";
+ }
+
=head2 Configurable failure contexts
@@ -3195,7 +3452,9 @@
handler of that name. Check the spelling for the requested export.
-=item C<Can't call %s in %s context>
+=item C<Can't call %s in a %s context>
+
+=item C<Can't use return value of %s in a %s context>
The subroutine you called uses a contextual return, but doesn't specify what
to return in the particular context in which you called it. You either need to
@@ -3204,6 +3463,16 @@
C<DEFAULT {...}> block).
+=item C<Can't call bare %s {...} in %s context>
+
+You specified a handler (such as C<VOID {...}> or C<LIST {...}>)
+outside any subroutine, and in a context that it
+can't handle. Did you mean to place the handler outside of a subroutine?
+If so, then you need to put it in a context it can actually handle.
+Otherwise, perhaps you need to replace the trailing block with parens
+(that is: C<VOID()> or C<LIST()>).
+
+
=item C<%s can't return a %s reference">
You called the subroutine in a context that expected to get back a
@@ -3337,7 +3606,7 @@
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2005-2006, Damian Conway C<< <dcon...@cpan.org> >>. All rights
reserved.
+Copyright (c) 2005-2011, Damian Conway C<< <dcon...@cpan.org> >>. All rights
reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/STRICT.t
new/Contextual-Return-0.004001/t/STRICT.t
--- old/Contextual-Return-0.003001/t/STRICT.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Contextual-Return-0.004001/t/STRICT.t 2012-02-16 03:41:26.000000000
+0100
@@ -0,0 +1,42 @@
+use Contextual::Return;
+
+sub bar {
+ return 'in bar';
+}
+
+sub foo {
+ return STRICT
+ PUREBOOL { 1 }
+ BOOL { 0 }
+ LIST { 1,2,3 }
+ NUM { 42 }
+ STR { 'forty-two' }
+ REF { [] }
+ DEFAULT { {} }
+ ;
+}
+
+package Other;
+use Test::More 'no_plan';
+
+is_deeply [ ::foo() ], [1,2,3] => 'LIST context';
+
+is do{ ::foo() ? 'true' : 'false' }, 'true' => 'PURE BOOLEAN
context';
+
+is do{ (my $x = ::foo()) ? 'true' : 'false' }, 'false' => 'BOOLEAN context';
+
+is 0+::foo(), 42 => 'NUMERIC context';
+
+is "".::foo(), 'forty-two' => 'STRING context';
+
+ok !eval { ::foo(); 1 } => 'No VOID context';
+like $@, qr{Can't call main::foo in a void context} => '...with correct
error msg';
+
+ok !eval { my $scalar = ${::foo()}; 1 } => 'No SCALARREF
context';
+like $@, qr{main::foo can't return a scalar reference} => '...with correct
error msg';
+
+ok !eval { my @list = @{::foo()}; 1 } => 'No
ARRAYREF context';
+like $@, qr{main::foo can't return an array reference} => '...with correct
error msg';
+
+ok !eval { my %hash = %{::foo()}; 1 } => 'No
HASHREF context';
+like $@, qr{main::foo can't return a hash reference} => '...with correct
error msg';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/fail.t
new/Contextual-Return-0.004001/t/fail.t
--- old/Contextual-Return-0.003001/t/fail.t 2008-08-12 12:46:59.000000000
+0200
+++ new/Contextual-Return-0.004001/t/fail.t 2010-10-04 06:32:57.000000000
+0200
@@ -16,11 +16,12 @@
return FAIL { 'fail_with_message() failed' }
}
-if ( ::fail_with_message() ) {
+if ( my $result = ::fail_with_message() ) {
ok 0 => 'Unexpected succeeded in bool context';
}
else {
ok 1 => 'Failed as expected in bool context';
+ like $result->error, qr/^fail_with_message\(\) failed/ => 'Failed with
expected message';
}
eval_nok { fail_with_message() }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/failures.t
new/Contextual-Return-0.004001/t/failures.t
--- old/Contextual-Return-0.003001/t/failures.t 2009-04-30 03:28:23.000000000
+0200
+++ new/Contextual-Return-0.004001/t/failures.t 2012-02-12 00:42:19.000000000
+0100
@@ -16,8 +16,8 @@
my ($msg, $line) = @_;
return sub {
# diag( "Caught warning: '@_'" );
- ok $_[0] =~ $msg => "Warn msg correct at $line";
- ok $_[0] =~ /line $line\Z/ => "Line number correct at $line";
+ ok $_[0] =~ $msg => "Warn msg correct at line $line";
+ ok $_[0] =~ /line $line\Z/ => "Line number correct at line $line";
}
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/fixed.t
new/Contextual-Return-0.004001/t/fixed.t
--- old/Contextual-Return-0.003001/t/fixed.t 2005-10-15 15:48:26.000000000
+0200
+++ new/Contextual-Return-0.004001/t/fixed.t 2012-02-16 03:05:04.000000000
+0100
@@ -23,6 +23,13 @@
;
}
+sub bar_list {
+ return FIXED
+ STR { 'forty-two' }
+ LIST { 1,2,3 }
+ ;
+}
+
sub baz {
return 'in baz';
}
@@ -91,6 +98,9 @@
is $oref->bar, "baaaaa!\n" => 'OBJREF context';
isnt ref($oref), $CLASS => 'After usage, it is not a
C::R::V';
+my @bar_list = ::bar_list();
+is_deeply \@bar_list, [1,2,3] => 'List context works correctly';
+
package Bar;
sub bar { return "baaaaa!\n"; }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/lvalue.t
new/Contextual-Return-0.004001/t/lvalue.t
--- old/Contextual-Return-0.003001/t/lvalue.t 2006-07-30 18:53:08.000000000
+0200
+++ new/Contextual-Return-0.004001/t/lvalue.t 2011-11-20 07:54:03.000000000
+0100
@@ -43,3 +43,16 @@
foo();
my $f = \foo();
+
+
+{
+ sub foo2 : lvalue {
+ LVALUE {
+ ok 1;
+ }
+ }
+}
+
+for my $foo (foo2) {
+ $foo = 99;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/pod-coverage.t
new/Contextual-Return-0.004001/t/pod-coverage.t
--- old/Contextual-Return-0.003001/t/pod-coverage.t 2006-02-13
03:40:08.000000000 +0100
+++ new/Contextual-Return-0.004001/t/pod-coverage.t 1970-01-01
01:00:00.000000000 +0100
@@ -1,6 +0,0 @@
-#!perl -T
-
-use Test::More;
-eval "use Test::Pod::Coverage 1.04";
-plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
if $@;
-all_pod_coverage_ok({ also_private => [ qr/^[A-Z_]+$/ ]});
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.003001/t/retobj.t
new/Contextual-Return-0.004001/t/retobj.t
--- old/Contextual-Return-0.003001/t/retobj.t 2009-11-28 08:15:23.000000000
+0100
+++ new/Contextual-Return-0.004001/t/retobj.t 2012-01-18 23:24:51.000000000
+0100
@@ -18,4 +18,7 @@
is ref $_, 'Contextual::Return::Value' => 'RETOBJ is object';
my $x;
+undef $_;
is do{ ($x = ::foo()) ? 'true' : 'false' }, 'true' => 'BOOLEAN context';
+
+ok !defined $_ => 'RETOBJ not assigned';
--
To unsubscribe, e-mail: opensuse-commit+unsubscr...@opensuse.org
For additional commands, e-mail: opensuse-commit+h...@opensuse.org
