summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-11-05 17:51:50 -0800
committerFather Chrysostomos <sprout@cpan.org>2013-11-06 05:56:04 -0800
commit9ce1fb7d2323e20e2cf2480171cbfb4f2b1153ea (patch)
treed4ba95e015ef45a6fdc4d598af274bdee2eb21b3
parent48c2c411a1dfc4a3e5e0e6829b02441a37bb3081 (diff)
downloadperl-9ce1fb7d2323e20e2cf2480171cbfb4f2b1153ea.tar.gz
Split ck_open into two functions
It is used for two op types, but only a small portion of it applies to both, so we can put that in a static function. This makes the next commit easier.
-rw-r--r--embed.h1
-rw-r--r--op.c85
-rw-r--r--opcode.h2
-rw-r--r--proto.h6
-rw-r--r--regen/opcodes2
5 files changed, 57 insertions, 39 deletions
diff --git a/embed.h b/embed.h
index a172226373..570ed1291d 100644
--- a/embed.h
+++ b/embed.h
@@ -1033,6 +1033,7 @@
#define cando(a,b,c) Perl_cando(aTHX_ a,b,c)
#define check_utf8_print(a,b) Perl_check_utf8_print(aTHX_ a,b)
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
+#define ck_backtick(a) Perl_ck_backtick(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_cmp(a) Perl_ck_cmp(aTHX_ a)
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
diff --git a/op.c b/op.c
index 12722dd000..fb214d90b4 100644
--- a/op.c
+++ b/op.c
@@ -8409,6 +8409,53 @@ Perl_ck_anoncode(pTHX_ OP *o)
return o;
}
+static void
+S_io_hints(pTHX_ OP *o)
+{
+ HV * const table =
+ PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;;
+ if (table) {
+ SV **svp = hv_fetchs(table, "open_IN", FALSE);
+ if (svp && *svp) {
+ STRLEN len = 0;
+ const char *d = SvPV_const(*svp, len);
+ const I32 mode = mode_from_discipline(d, len);
+ if (mode & O_BINARY)
+ o->op_private |= OPpOPEN_IN_RAW;
+ else if (mode & O_TEXT)
+ o->op_private |= OPpOPEN_IN_CRLF;
+ }
+
+ svp = hv_fetchs(table, "open_OUT", FALSE);
+ if (svp && *svp) {
+ STRLEN len = 0;
+ const char *d = SvPV_const(*svp, len);
+ const I32 mode = mode_from_discipline(d, len);
+ if (mode & O_BINARY)
+ o->op_private |= OPpOPEN_OUT_RAW;
+ else if (mode & O_TEXT)
+ o->op_private |= OPpOPEN_OUT_CRLF;
+ }
+ }
+}
+
+OP *
+Perl_ck_backtick(pTHX_ OP *o)
+{
+ PERL_ARGS_ASSERT_CK_BACKTICK;
+ S_io_hints(aTHX_ o);
+ if (!(o->op_flags & OPf_KIDS)) {
+ OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
+#ifdef PERL_MAD
+ op_getmad(o,newop,'O');
+#else
+ op_free(o);
+#endif
+ return newop;
+ }
+ return o;
+}
+
OP *
Perl_ck_bitop(pTHX_ OP *o)
{
@@ -9603,46 +9650,10 @@ OP *
Perl_ck_open(pTHX_ OP *o)
{
dVAR;
- HV * const table =
- PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;;
PERL_ARGS_ASSERT_CK_OPEN;
- if (table) {
- SV **svp = hv_fetchs(table, "open_IN", FALSE);
- if (svp && *svp) {
- STRLEN len = 0;
- const char *d = SvPV_const(*svp, len);
- const I32 mode = mode_from_discipline(d, len);
- if (mode & O_BINARY)
- o->op_private |= OPpOPEN_IN_RAW;
- else if (mode & O_TEXT)
- o->op_private |= OPpOPEN_IN_CRLF;
- }
-
- svp = hv_fetchs(table, "open_OUT", FALSE);
- if (svp && *svp) {
- STRLEN len = 0;
- const char *d = SvPV_const(*svp, len);
- const I32 mode = mode_from_discipline(d, len);
- if (mode & O_BINARY)
- o->op_private |= OPpOPEN_OUT_RAW;
- else if (mode & O_TEXT)
- o->op_private |= OPpOPEN_OUT_CRLF;
- }
- }
- if (o->op_type == OP_BACKTICK) {
- if (!(o->op_flags & OPf_KIDS)) {
- OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
-#ifdef PERL_MAD
- op_getmad(o,newop,'O');
-#else
- op_free(o);
-#endif
- return newop;
- }
- return o;
- }
+ S_io_hints(aTHX_ o);
{
/* In case of three-arg dup open remove strictness
* from the last arg if it is a bareword. */
diff --git a/opcode.h b/opcode.h
index 44067824b2..9a9ef1e60a 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1357,7 +1357,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_null, /* srefgen */
Perl_ck_fun, /* ref */
Perl_ck_fun, /* bless */
- Perl_ck_open, /* backtick */
+ Perl_ck_backtick, /* backtick */
Perl_ck_glob, /* glob */
Perl_ck_readline, /* readline */
Perl_ck_null, /* rcatline */
diff --git a/proto.h b/proto.h
index 2d4b155191..c8811e4a84 100644
--- a/proto.h
+++ b/proto.h
@@ -365,6 +365,12 @@ PERL_CALLCONV OP * Perl_ck_anoncode(pTHX_ OP *o)
#define PERL_ARGS_ASSERT_CK_ANONCODE \
assert(o)
+PERL_CALLCONV OP * Perl_ck_backtick(pTHX_ OP *o)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CK_BACKTICK \
+ assert(o)
+
PERL_CALLCONV OP * Perl_ck_bitop(pTHX_ OP *o)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
diff --git a/regen/opcodes b/regen/opcodes
index b15fa2053f..f904b06882 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -73,7 +73,7 @@ bless bless ck_fun s@ S S?
# Pushy I/O.
-backtick quoted execution (``, qx) ck_open tu% S?
+backtick quoted execution (``, qx) ck_backtick tu% S?
# glob defaults its first arg to $_
glob glob ck_glob t@ S?
readline <HANDLE> ck_readline t% F?