Re: $, and say

Message-ID: <lrek2t1e8n.fsf@caliper.activestate.com>

with tweaks so "say;" continues to default to $_
plus a regression test

p4raw-id: //depot/perl@29187

diff --git a/embed.fnc b/embed.fnc
index 819bf43..2d88011 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1160,7 +1160,6 @@ pR        |OP*    |ck_return      |NN OP *o
 pR     |OP*    |ck_rfun        |NN OP *o
 pR     |OP*    |ck_rvconst     |NN OP *o
 pR     |OP*    |ck_sassign     |NN OP *o
-pR     |OP*    |ck_say         |NN OP *o
 pR     |OP*    |ck_select      |NN OP *o
 pR     |OP*    |ck_shift       |NN OP *o
 pR     |OP*    |ck_sort        |NN OP *o

diff --git a/embed.h b/embed.h
index 9241cc6..713d7da 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1154,7 +1154,6 @@
 #define ck_rfun                        Perl_ck_rfun
 #define ck_rvconst             Perl_ck_rvconst
 #define ck_sassign             Perl_ck_sassign
-#define ck_say                 Perl_ck_say
 #define ck_select              Perl_ck_select
 #define ck_shift               Perl_ck_shift
 #define ck_sort                        Perl_ck_sort
@@ -1874,7 +1873,6 @@
 #define ck_rfun                        Perl_ck_rfun
 #define ck_rvconst             Perl_ck_rvconst
 #define ck_sassign             Perl_ck_sassign
-#define ck_say                 Perl_ck_say
 #define ck_select              Perl_ck_select
 #define ck_shift               Perl_ck_shift
 #define ck_smartmatch          Perl_ck_smartmatch
@@ -3356,7 +3354,6 @@
 #define ck_rfun(a)             Perl_ck_rfun(aTHX_ a)
 #define ck_rvconst(a)          Perl_ck_rvconst(aTHX_ a)
 #define ck_sassign(a)          Perl_ck_sassign(aTHX_ a)
-#define ck_say(a)              Perl_ck_say(aTHX_ a)
 #define ck_select(a)           Perl_ck_select(aTHX_ a)
 #define ck_shift(a)            Perl_ck_shift(aTHX_ a)
 #define ck_sort(a)             Perl_ck_sort(aTHX_ a)
@@ -4083,7 +4080,6 @@
 #define ck_rfun(a)             Perl_ck_rfun(aTHX_ a)
 #define ck_rvconst(a)          Perl_ck_rvconst(aTHX_ a)
 #define ck_sassign(a)          Perl_ck_sassign(aTHX_ a)
-#define ck_say(a)              Perl_ck_say(aTHX_ a)
 #define ck_select(a)           Perl_ck_select(aTHX_ a)
 #define ck_shift(a)            Perl_ck_shift(aTHX_ a)
 #define ck_smartmatch(a)       Perl_ck_smartmatch(aTHX_ a)

diff --git a/op.c b/op.c
index 0ebaedd..a6346f6 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6754,16 +6754,6 @@ Perl_ck_listiob(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_say(pTHX_ OP *o)
-{
-    o = ck_listiob(o);
-    o->op_type = OP_PRINT;
-    cLISTOPo->op_last = cLISTOPo->op_last->op_sibling
-       = newSVOP(OP_CONST, 0, newSVpvs("\n"));
-    return o;
-}
-
-OP *
 Perl_ck_smartmatch(pTHX_ OP *o)
 {
     dVAR;

diff --git a/opcode.h b/opcode.h
index c62943b..6789546 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1524,7 +1524,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_ck_null),   /* break */
        MEMBER_TO_FPTR(Perl_ck_null),   /* continue */
        MEMBER_TO_FPTR(Perl_ck_smartmatch),     /* smartmatch */
-       MEMBER_TO_FPTR(Perl_ck_say),    /* say */
+       MEMBER_TO_FPTR(Perl_ck_listiob),        /* say */
        MEMBER_TO_FPTR(Perl_ck_null),   /* custom */
 }
 #endif

diff --git a/opcode.pl b/opcode.pl
index 7857c09..6988f88 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -1045,7 +1045,7 @@ break             break                   ck_null         0
 continue       continue                ck_null         0
 smartmatch     smart match             ck_smartmatch   s2
 
-say            say                     ck_say          ims@    F? L
+say            say                     ck_listiob      ims@    F? L
 
 # Add new ops before this, the custom operator.
 

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 9e7414a..5ef30d7 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -4718,11 +4718,8 @@ X<say>
 =item say
 
 Just like C<print>, but implicitly appends a newline.
-C<say LIST> is simply an abbreviation for C<print LIST, "\n">,
-and C<say()> works just like C<print($_, "\n")>.
-
-That means that a call to say() appends any output record separator
-I<after> the added newline.
+C<say LIST> is simply an abbreviation for C<{ local $/ = "\n"; print
+LIST }>.
 
 This keyword is only available when the "say" feature is
 enabled: see L<feature>.

diff --git a/pp.sym b/pp.sym
index 2ca789f..146ef4a 100644 (file)
--- a/pp.sym
+++ b/pp.sym
@@ -36,7 +36,6 @@ Perl_ck_return
 Perl_ck_rfun
 Perl_ck_rvconst
 Perl_ck_sassign
-Perl_ck_say
 Perl_ck_select
 Perl_ck_shift
 Perl_ck_smartmatch

diff --git a/pp_hot.c b/pp_hot.c
index be69c99..d1873b2 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -752,7 +752,11 @@ PP(pp_print)
        if (MARK <= SP)
            goto just_say_no;
        else {
-           if (PL_ors_sv && SvOK(PL_ors_sv))
+           if (PL_op->op_type == OP_SAY) {
+               if (PerlIO_write(fp, "\n", 1) == 0 || PerlIO_error(fp))
+                   goto just_say_no;
+           }
+            else if (PL_ors_sv && SvOK(PL_ors_sv))
                if (!do_print(PL_ors_sv, fp)) /* $\ */
                    goto just_say_no;
 

diff --git a/pp_proto.h b/pp_proto.h
index 1a368cd..08e9ad7 100644 (file)
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -35,7 +35,6 @@ PERL_CKDEF(Perl_ck_return)
 PERL_CKDEF(Perl_ck_rfun)
 PERL_CKDEF(Perl_ck_rvconst)
 PERL_CKDEF(Perl_ck_sassign)
-PERL_CKDEF(Perl_ck_say)
 PERL_CKDEF(Perl_ck_select)
 PERL_CKDEF(Perl_ck_shift)
 PERL_CKDEF(Perl_ck_smartmatch)

diff --git a/proto.h b/proto.h
index 2e75d90..c6f398a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3141,10 +3141,6 @@ PERL_CALLCONV OP*        Perl_ck_sassign(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 
-PERL_CALLCONV OP*      Perl_ck_say(pTHX_ OP *o)
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1);
-
 PERL_CALLCONV OP*      Perl_ck_select(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/t/io/say.t b/t/io/say.t
index 62cec80..1da7a18 100644 (file)
--- a/t/io/say.t
+++ b/t/io/say.t
@@ -16,7 +16,7 @@ die $@ if $@ and !$ENV{PERL_CORE_MINITEST};
 
 use feature "say";
 
-say "1..11";
+say "1..12";
 
 my $foo = 'STDOUT';
 say $foo "ok 1";
@@ -47,3 +47,9 @@ say;
 
 $_ = "ok 11";
 say STDOUT;
+
+{
+    # test that $, doesn't show up before the trailing \n
+    local $, = "\nnot ok 13"; # how to fool Test::Harness
+    say "ok 12";
+}