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

11 files changed, 16 insertions, 30 deletions

diff --git a/embed.fnc b/embed.fnc
index 819bf4398e..2d8801156e 100644
--- 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 9241cc651d..713d7dae52 100644
--- 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 0ebaedd43b..a6346f696d 100644
--- 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 c62943b57d..6789546b19 100644
--- 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 7857c09651..6988f88405 100755
--- 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 9e7414a70f..5ef30d7aea 100644
--- 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 2ca789f18d..146ef4a796 100644
--- 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 be69c99942..d1873b2a32 100644
--- 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 1a368cdf5c..08e9ad74af 100644
--- 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 2e75d902ed..c6f398a6a9 100644
--- 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 62cec80237..1da7a18d8f 100644
--- 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";
+}