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