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 819bf4398e5148abd064e6fe49c3e89e2f986eb5..2d8801156e5bbf15a511e0636067f4c3e88f113d 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 9241cc651d767fa0646ca30c31f22149b39694c2..713d7dae523194a9e24652115de0ba172b3d8c5a 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 0ebaedd43b315ba761f92378f0e31f9151e34243..a6346f696de497bac3486143efb8a5de5b80fb4e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6753,16 +6753,6 @@ Perl_ck_listiob(pTHX_ OP *o)
     return listkids(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)
 {

diff --git a/opcode.h b/opcode.h
index c62943b57d8a4a27e87ee8c3c563a8c739bec779..6789546b1987e650ac6386de60f96980fcc8e5a4 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 7857c0965167ad5a936f762174ae0d8025e4ff09..6988f88405021d6f93fc6356f8a280748c440b2f 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 9e7414a70fe34e5a47a3d92e2b49839673efb72d..5ef30d7aead6f0491c2b867a2fe7afeeaf211add 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 2ca789f18d6548a381af89cba5ec0cf60a4b1bb5..146ef4a7963f5ad74f6c4bfd8cad3578a82b0a69 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 be69c99942c4b2200190588e123f371cdd1cd63a..d1873b2a32f2f658a562584952b006e2bb9e7419 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 1a368cdf5cee2f186917dc1ab17381a63e755eac..08e9ad74af2db0ab2cc6e88d2dd72e441c12f315 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 2e75d902ed9118c0679bb95a67f2989a92c0e9d9..c6f398a6a981f1eab043a29c281e924e89019d20 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 62cec80237e9c18a48f0a42c0a9da4fdb81635d1..1da7a18d8f3eac26d7fb21b693141ef2ab44e107 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";
+}