properly prototype check parenthesized unary ops (e.g. defined(&a,&b))

p4raw-id: //depot/perl@2817

diff --git a/op.c b/op.c
index 94fbc15..8f15a10 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4642,6 +4642,12 @@ ck_fun(OP *o)
            sibl = kid->op_sibling;
            switch (oa & 7) {
            case OA_SCALAR:
+               /* list seen where single (scalar) arg expected? */
+               if (numargs == 1 && !(oa >> 4)
+                   && kid->op_type == OP_LIST && type != OP_SCALAR)
+               {
+                   return too_many_arguments(o,PL_op_desc[type]);
+               }
                scalar(kid);
                break;
            case OA_LIST:
@@ -4654,7 +4660,8 @@ ck_fun(OP *o)
                break;
            case OA_AVREF:
                if (kid->op_type == OP_CONST &&
-                 (kid->op_private & OPpCONST_BARE)) {
+                   (kid->op_private & OPpCONST_BARE))
+               {
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
@@ -4673,7 +4680,8 @@ ck_fun(OP *o)
                break;
            case OA_HVREF:
                if (kid->op_type == OP_CONST &&
-                 (kid->op_private & OPpCONST_BARE)) {
+                   (kid->op_private & OPpCONST_BARE))
+               {
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
@@ -4704,7 +4712,8 @@ ck_fun(OP *o)
            case OA_FILEREF:
                if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
                    if (kid->op_type == OP_CONST &&
-                     (kid->op_private & OPpCONST_BARE)) {
+                       (kid->op_private & OPpCONST_BARE))
+                   {
                        OP *newop = newGVOP(OP_GV, 0,
                            gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
                                        SVt_PVIO) );

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 9bb27ab..17ca348 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -62,6 +62,29 @@ somewhat 64-bit aware platforms are HP-UX 11 or better, Solaris 2.6 or
 better, IRIX 6.2 or better.  Naturally 64-bit platforms like Digital
 UNIX and UNICOS also have 64-bit support.
 
+=head2 Better syntax checks on parenthesized unary operators
+
+Expressions such as:
+
+       print defined(&foo,&bar,&baz);
+       print uc("foo","bar","baz");
+       undef($foo,&bar);
+
+used to be accidentally allowed in earlier versions, and produced 
+unpredictable behavior.  Some of them produced ancillary warnings
+when used in this way, while others silently did the wrong thing.
+
+The parenthesized forms of most unary operators that expect a single
+argument will now ensure that they are not called with more than one
+argument, making the above cases syntax errors.  Note that the usual
+behavior of:
+
+       print defined &foo, &bar, &baz;
+       print uc "foo", "bar", "baz";
+       undef $foo, &bar;
+
+remains unchanged.  See L<perlop>.
+
 =head1 Supported Platforms
 
 =over 4

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index ef27b8b..3b5c5dd 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -3069,6 +3069,23 @@ needed.  If you really wanted to do so, however, you could use
 the construction C<@{[ (some expression) ]}>, but usually a simple
 C<(some expression)> suffices.
 
+Though C<scalar> can be considered in general to be a unary operator,
+EXPR is also allowed to be a parenthesized list.  The list in fact
+behaves as a scalar comma expression, evaluating all but the last
+element in void context and returning the final element evaluated in
+a scalar context.
+
+The following single statement:
+
+       print uc(scalar(&foo,$bar)),$baz;
+
+is the moral equivalent of these two:
+
+       &foo;
+       print(uc($bar),$baz);
+
+See L<perlop> for more details on unary operators and the comma operator.
+
 =item seek FILEHANDLE,POSITION,WHENCE
 
 Sets FILEHANDLE's position, just like the C<fseek()> call of C<stdio()>.

diff --git a/pod/perlop.pod b/pod/perlop.pod
index a485781..01c5d0e 100644 (file)
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -44,7 +44,7 @@ Many operators can be overloaded for objects.  See L<overload>.
 
 =head2 Terms and List Operators (Leftward)
 
-A TERM has the highest precedence in Perl.  They includes variables,
+A TERM has the highest precedence in Perl.  They include variables,
 quote and quote-like operators, any expression in parentheses,
 and any function whose arguments are parenthesized.  Actually, there
 aren't really functions in this sense, just list operators and unary

diff --git a/t/comp/bproto.t b/t/comp/bproto.t
new file mode 100755 (executable)
index 0000000..699ea57
--- /dev/null
+++ b/t/comp/bproto.t
@@ -0,0 +1,41 @@
+#!./perl
+#
+# check if builtins behave as prototyped
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+print "1..7\n";
+
+my $i = 1;
+
+sub foo {}
+my $bar = "bar";
+
+sub test_too_many {
+    eval $_[0];
+    print "not " unless $@ =~ /^Too many arguments/;
+    printf "ok %d\n",$i++;
+}
+
+sub test_no_error {
+    eval $_[0];
+    print "not " if $@;
+    printf "ok %d\n",$i++;
+}
+
+test_too_many($_) for split /\n/,
+q[     defined(&foo, $bar);
+       undef(&foo, $bar);
+       uc($bar,$bar);
+];
+
+test_no_error($_) for split /\n/,
+q[     scalar(&foo,$bar);
+       defined &foo, &foo, &foo;
+       undef &foo, $bar;
+       uc $bar,$bar;
+];