summaryrefslogtreecommitdiff
path: root/t/comp
diff options
context:
space:
mode:
authorDavid Golden <dagolden@cpan.org>2010-09-12 20:26:43 -0400
committerDavid Golden <dagolden@cpan.org>2010-10-21 09:23:58 -0400
commitc035a075a240f10383292128a8d3f3746c4ac857 (patch)
treea245d8f117b9636fe740448118a753e5457978c8 /t/comp
parent9061a8f72941979d02cbccb5cb18a2034813b6a7 (diff)
downloadperl-c035a075a240f10383292128a8d3f3746c4ac857.tar.gz
Add single-term prototype
The C<+> prototype is a special alternative to C<$> that will act like C<\[@%]> when given a literal array or hash variable, but will otherwise force scalar context on the argument. This is useful for functions which should accept either a literal array or an array reference as the argument: sub smartpush (+@) { my $aref = shift; die "Not an array or arrayref" unless ref $aref eq 'ARRAY'; push @$aref, @_; } When using the C<+> prototype, your function must check that the argument is of an acceptable type.
Diffstat (limited to 't/comp')
-rw-r--r--t/comp/proto.t27
1 files changed, 26 insertions, 1 deletions
diff --git a/t/comp/proto.t b/t/comp/proto.t
index e785a9bdd6..e38ba11535 100644
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -18,7 +18,7 @@ BEGIN {
# strict
use strict;
-print "1..160\n";
+print "1..168\n";
my $i = 1;
@@ -546,6 +546,25 @@ sub sreftest (\$$) {
sreftest $aelem[0], $i++;
}
+# test single term
+sub lazy (+$$) {
+ print "not " unless @_ == 3 && ref $_[0] eq $_[1];
+ print "ok $_[2] - non container test\n";
+}
+sub quietlazy (+) { return shift(@_) }
+sub give_aref { [] }
+sub list_or_scalar { wantarray ? (1..10) : [] }
+{
+ my @multiarray = ("a".."z");
+ my %bighash = @multiarray;
+ lazy(\@multiarray, 'ARRAY', $i++);
+ lazy(\%bighash, 'HASH', $i++);
+ lazy({}, 'HASH', $i++);
+ lazy(give_aref, 'ARRAY', $i++);
+ lazy(3, '', $i++); # allowed by prototype, even if runtime error
+ lazy(list_or_scalar, 'ARRAY', $i++); # propagate scalar context
+}
+
# test prototypes when they are evaled and there is a syntax error
# Byacc generates the string "syntax error". Bison gives the
# string "parse error".
@@ -676,3 +695,9 @@ print "ok ", $i++, "\n";
print "not "
unless eval 'sub uniproto7 (;\[$%@]) {} uniproto7 @_, 1' or warn $@;
print "ok ", $i++, "\n";
+print "not "
+ unless eval 'sub uniproto8 (+) {} uniproto8 $_, 1' or warn $@;
+print "ok ", $i++, "\n";
+print "not "
+ unless eval 'sub uniproto9 (;+) {} uniproto9 $_, 1' or warn $@;
+print "ok ", $i++, "\n";