summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST1
-rw-r--r--dist/B-Deparse/Deparse.pm23
-rw-r--r--dist/B-Deparse/t/core.t7
-rw-r--r--dist/B-Deparse/t/deparse.t1
-rw-r--r--ext/B/t/concise-xs.t2
-rw-r--r--keywords.c48
-rw-r--r--keywords.h393
-rw-r--r--lib/feature.pm4
-rw-r--r--op.c38
-rw-r--r--op.h2
-rw-r--r--opcode.h2
-rw-r--r--pp_ctl.c17
-rwxr-xr-xregen/keywords.pl3
-rw-r--r--regen/opcodes2
-rw-r--r--t/op/coreamp.t29
-rw-r--r--t/op/coresubs.t2
-rw-r--r--t/op/cproto.t3
-rw-r--r--t/op/evalbytes.t34
-rw-r--r--toke.c4
19 files changed, 379 insertions, 236 deletions
diff --git a/MANIFEST b/MANIFEST
index 058a57203f..30dfe5703d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5091,6 +5091,7 @@ t/op/dor.t See if defined-or (//) works
t/op/do.t See if subroutines work
t/op/each_array.t See if array iterators work
t/op/each.t See if hash iterators work
+t/op/evalbytes.t See if evalbytes operator works
t/op/eval.t See if eval operator works
t/op/exec.t See if exec, system and qx work
t/op/exists_sub.t See if exists(&sub) works
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index b8b30f3729..428466b519 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -33,7 +33,10 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
# version number bumped to 5.15.3, this can be reduced to
# just test $] < 5.015003.
($] < 5.015002 || do { require B; exists(&B::OPpCONST_ARYBASE) })
- ? qw(OPpCONST_ARYBASE) : ());
+ ? qw(OPpCONST_ARYBASE) : ()),
+ ($] < 5.015005 &&
+ ($] < 5.015004 || do { require B; exists(&B::OPpEVAL_BYTES) })
+ ? qw(OPpEVAL_BYTES) : ());
$VERSION = "1.09";
use strict;
use vars qw/$AUTOLOAD/;
@@ -44,7 +47,7 @@ BEGIN {
# be to fake up a dummy constant that will never actually be true.
foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER
OPpPAD_STATE RXf_SKIPWHITE CVf_LOCKED OPpREVERSE_INPLACE
- PMf_NONDESTRUCT OPpCONST_ARYBASE)) {
+ PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) {
no strict 'refs';
*{$_} = sub () {0} unless *{$_}{CODE};
}
@@ -1557,6 +1560,7 @@ my %feature_keywords = (
when => 'switch',
default => 'switch',
break => 'switch',
+ evalbytes=>'evalbytes',
);
sub keyword {
@@ -1564,11 +1568,9 @@ sub keyword {
my $name = shift;
return $name if $name =~ /^CORE::/; # just in case
if (exists $feature_keywords{$name}) {
- return
- $self->{'hinthash'}
- && $self->{'hinthash'}{"feature_$feature_keywords{$name}"}
- ? $name
- : "CORE::$name";
+ return "CORE::$name"
+ if !$self->{'hinthash'}
+ || !$self->{'hinthash'}{"feature_$feature_keywords{$name}"}
}
if (
$name !~ /^(?:chom?p|do|exec|glob|s(?:elect|ystem))\z/
@@ -1766,7 +1768,12 @@ sub pp_alarm { unop(@_, "alarm") }
sub pp_sleep { maybe_targmy(@_, \&unop, "sleep") }
sub pp_dofile { unop(@_, "do") }
-sub pp_entereval { unop(@_, "eval") }
+sub pp_entereval {
+ unop(
+ @_,
+ $_[1]->private & OPpEVAL_BYTES ? $_[0]->keyword('evalbytes') : "eval"
+ )
+}
sub pp_ghbyname { unop(@_, "gethostbyname") }
sub pp_gnbyname { unop(@_, "getnetbyname") }
diff --git a/dist/B-Deparse/t/core.t b/dist/B-Deparse/t/core.t
index 2d5aa32919..81d9038b8a 100644
--- a/dist/B-Deparse/t/core.t
+++ b/dist/B-Deparse/t/core.t
@@ -10,6 +10,8 @@ BEGIN {
use strict;
use Test::More;
+use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
+ # logic to add CORE::
# Many functions appear in multiple lists, so that shift() and shift(foo)
# are both tested.
@@ -18,7 +20,8 @@ my @nary = (
# nullary functions
[qw( abs alarm break chr cos chop close chdir chomp chmod chown
chroot caller continue die dump exp exit exec endgrent
- endpwent endnetent endhostent endservent endprotoent fork glob
+ endpwent endnetent endhostent endservent
+ endprotoent evalbytes fork glob
getppid getpwent getprotoent gethostent getnetent getservent
getgrent getlogin getc gmtime hex int lc log lstat length
lcfirst localtime mkdir ord oct pop quotemeta ref rand
@@ -28,7 +31,7 @@ my @nary = (
# unary
[qw( abs alarm bless binmode chr cos chop close chdir chomp
chmod chown chroot closedir die do dump exp exit exec
- each fileno getpgrp getpwnam getpwuid getpeername
+ each evalbytes fileno getpgrp getpwnam getpwuid getpeername
getprotobyname getprotobynumber gethostbyname
getnetbyname getsockname getgrnam getgrgid
getc glob gmtime hex int join keys kill lc
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 53b8d23202..ef66090ee5 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -765,6 +765,7 @@ CORE::given ($x) {
CORE::break;
}
}
+CORE::evalbytes '';
####
# $#- $#+ $#{%} etc.
my @x;
diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index 67b8591701..5e88b9fe63 100644
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -169,7 +169,7 @@ my $testpkgs = {
PMf_MULTILINE PMf_ONCE PMf_SINGLELINE
POSTFIX SVf_FAKE SVf_IOK SVf_NOK SVf_POK SVf_ROK
SVpad_OUR SVs_RMG SVs_SMG SWAP_CHILDREN OPpPAD_STATE
- OPpCONST_ARYBASE
+ OPpCONST_ARYBASE OPpEVAL_BYTES
/, $] > 5.009 ? ('RXf_SKIPWHITE') : ('PMf_SKIPWHITE'),
'CVf_LOCKED', # This ends up as a constant, pre or post 5.10
],
diff --git a/keywords.c b/keywords.c
index b9ef465967..921d55077e 100644
--- a/keywords.c
+++ b/keywords.c
@@ -2740,7 +2740,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
goto unknown;
}
- case 9: /* 9 tokens of length 9 */
+ case 9: /* 10 tokens of length 9 */
switch (name[0])
{
case 'U':
@@ -2759,19 +2759,39 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
goto unknown;
case 'e':
- if (name[1] == 'n' &&
- name[2] == 'd' &&
- name[3] == 'n' &&
- name[4] == 'e' &&
- name[5] == 't' &&
- name[6] == 'e' &&
- name[7] == 'n' &&
- name[8] == 't')
- { /* endnetent */
- return -KEY_endnetent;
- }
+ switch (name[1])
+ {
+ case 'n':
+ if (name[2] == 'd' &&
+ name[3] == 'n' &&
+ name[4] == 'e' &&
+ name[5] == 't' &&
+ name[6] == 'e' &&
+ name[7] == 'n' &&
+ name[8] == 't')
+ { /* endnetent */
+ return -KEY_endnetent;
+ }
- goto unknown;
+ goto unknown;
+
+ case 'v':
+ if (name[2] == 'a' &&
+ name[3] == 'l' &&
+ name[4] == 'b' &&
+ name[5] == 'y' &&
+ name[6] == 't' &&
+ name[7] == 'e' &&
+ name[8] == 's')
+ { /* evalbytes */
+ return (all_keywords || FEATURE_IS_ENABLED("evalbytes") ? -KEY_evalbytes : 0);
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
case 'g':
if (name[1] == 'e' &&
@@ -3399,5 +3419,5 @@ unknown:
}
/* Generated from:
- * 6563b55da87af894b79ef9d777217633eee6c7b5f352ff4c17317f562247f5fc regen/keywords.pl
+ * 370a83cf6eed30dfe61a9dc611013e1014e0c5f537dc4f3872576ba8b9ef7572 regen/keywords.pl
* ex: set ro: */
diff --git a/keywords.h b/keywords.h
index 83ad0efb56..c33f6687c1 100644
--- a/keywords.h
+++ b/keywords.h
@@ -71,202 +71,203 @@
#define KEY_eof 55
#define KEY_eq 56
#define KEY_eval 57
-#define KEY_exec 58
-#define KEY_exists 59
-#define KEY_exit 60
-#define KEY_exp 61
-#define KEY_fcntl 62
-#define KEY_fileno 63
-#define KEY_flock 64
-#define KEY_for 65
-#define KEY_foreach 66
-#define KEY_fork 67
-#define KEY_format 68
-#define KEY_formline 69
-#define KEY_ge 70
-#define KEY_getc 71
-#define KEY_getgrent 72
-#define KEY_getgrgid 73
-#define KEY_getgrnam 74
-#define KEY_gethostbyaddr 75
-#define KEY_gethostbyname 76
-#define KEY_gethostent 77
-#define KEY_getlogin 78
-#define KEY_getnetbyaddr 79
-#define KEY_getnetbyname 80
-#define KEY_getnetent 81
-#define KEY_getpeername 82
-#define KEY_getpgrp 83
-#define KEY_getppid 84
-#define KEY_getpriority 85
-#define KEY_getprotobyname 86
-#define KEY_getprotobynumber 87
-#define KEY_getprotoent 88
-#define KEY_getpwent 89
-#define KEY_getpwnam 90
-#define KEY_getpwuid 91
-#define KEY_getservbyname 92
-#define KEY_getservbyport 93
-#define KEY_getservent 94
-#define KEY_getsockname 95
-#define KEY_getsockopt 96
-#define KEY_given 97
-#define KEY_glob 98
-#define KEY_gmtime 99
-#define KEY_goto 100
-#define KEY_grep 101
-#define KEY_gt 102
-#define KEY_hex 103
-#define KEY_if 104
-#define KEY_index 105
-#define KEY_int 106
-#define KEY_ioctl 107
-#define KEY_join 108
-#define KEY_keys 109
-#define KEY_kill 110
-#define KEY_last 111
-#define KEY_lc 112
-#define KEY_lcfirst 113
-#define KEY_le 114
-#define KEY_length 115
-#define KEY_link 116
-#define KEY_listen 117
-#define KEY_local 118
-#define KEY_localtime 119
-#define KEY_lock 120
-#define KEY_log 121
-#define KEY_lstat 122
-#define KEY_lt 123
-#define KEY_m 124
-#define KEY_map 125
-#define KEY_mkdir 126
-#define KEY_msgctl 127
-#define KEY_msgget 128
-#define KEY_msgrcv 129
-#define KEY_msgsnd 130
-#define KEY_my 131
-#define KEY_ne 132
-#define KEY_next 133
-#define KEY_no 134
-#define KEY_not 135
-#define KEY_oct 136
-#define KEY_open 137
-#define KEY_opendir 138
-#define KEY_or 139
-#define KEY_ord 140
-#define KEY_our 141
-#define KEY_pack 142
-#define KEY_package 143
-#define KEY_pipe 144
-#define KEY_pop 145
-#define KEY_pos 146
-#define KEY_print 147
-#define KEY_printf 148
-#define KEY_prototype 149
-#define KEY_push 150
-#define KEY_q 151
-#define KEY_qq 152
-#define KEY_qr 153
-#define KEY_quotemeta 154
-#define KEY_qw 155
-#define KEY_qx 156
-#define KEY_rand 157
-#define KEY_read 158
-#define KEY_readdir 159
-#define KEY_readline 160
-#define KEY_readlink 161
-#define KEY_readpipe 162
-#define KEY_recv 163
-#define KEY_redo 164
-#define KEY_ref 165
-#define KEY_rename 166
-#define KEY_require 167
-#define KEY_reset 168
-#define KEY_return 169
-#define KEY_reverse 170
-#define KEY_rewinddir 171
-#define KEY_rindex 172
-#define KEY_rmdir 173
-#define KEY_s 174
-#define KEY_say 175
-#define KEY_scalar 176
-#define KEY_seek 177
-#define KEY_seekdir 178
-#define KEY_select 179
-#define KEY_semctl 180
-#define KEY_semget 181
-#define KEY_semop 182
-#define KEY_send 183
-#define KEY_setgrent 184
-#define KEY_sethostent 185
-#define KEY_setnetent 186
-#define KEY_setpgrp 187
-#define KEY_setpriority 188
-#define KEY_setprotoent 189
-#define KEY_setpwent 190
-#define KEY_setservent 191
-#define KEY_setsockopt 192
-#define KEY_shift 193
-#define KEY_shmctl 194
-#define KEY_shmget 195
-#define KEY_shmread 196
-#define KEY_shmwrite 197
-#define KEY_shutdown 198
-#define KEY_sin 199
-#define KEY_sleep 200
-#define KEY_socket 201
-#define KEY_socketpair 202
-#define KEY_sort 203
-#define KEY_splice 204
-#define KEY_split 205
-#define KEY_sprintf 206
-#define KEY_sqrt 207
-#define KEY_srand 208
-#define KEY_stat 209
-#define KEY_state 210
-#define KEY_study 211
-#define KEY_sub 212
-#define KEY_substr 213
-#define KEY_symlink 214
-#define KEY_syscall 215
-#define KEY_sysopen 216
-#define KEY_sysread 217
-#define KEY_sysseek 218
-#define KEY_system 219
-#define KEY_syswrite 220
-#define KEY_tell 221
-#define KEY_telldir 222
-#define KEY_tie 223
-#define KEY_tied 224
-#define KEY_time 225
-#define KEY_times 226
-#define KEY_tr 227
-#define KEY_truncate 228
-#define KEY_uc 229
-#define KEY_ucfirst 230
-#define KEY_umask 231
-#define KEY_undef 232
-#define KEY_unless 233
-#define KEY_unlink 234
-#define KEY_unpack 235
-#define KEY_unshift 236
-#define KEY_untie 237
-#define KEY_until 238
-#define KEY_use 239
-#define KEY_utime 240
-#define KEY_values 241
-#define KEY_vec 242
-#define KEY_wait 243
-#define KEY_waitpid 244
-#define KEY_wantarray 245
-#define KEY_warn 246
-#define KEY_when 247
-#define KEY_while 248
-#define KEY_write 249
-#define KEY_x 250
-#define KEY_xor 251
-#define KEY_y 252
+#define KEY_evalbytes 58
+#define KEY_exec 59
+#define KEY_exists 60
+#define KEY_exit 61
+#define KEY_exp 62
+#define KEY_fcntl 63
+#define KEY_fileno 64
+#define KEY_flock 65
+#define KEY_for 66
+#define KEY_foreach 67
+#define KEY_fork 68
+#define KEY_format 69
+#define KEY_formline 70
+#define KEY_ge 71
+#define KEY_getc 72
+#define KEY_getgrent 73
+#define KEY_getgrgid 74
+#define KEY_getgrnam 75
+#define KEY_gethostbyaddr 76
+#define KEY_gethostbyname 77
+#define KEY_gethostent 78
+#define KEY_getlogin 79
+#define KEY_getnetbyaddr 80
+#define KEY_getnetbyname 81
+#define KEY_getnetent 82
+#define KEY_getpeername 83
+#define KEY_getpgrp 84
+#define KEY_getppid 85
+#define KEY_getpriority 86
+#define KEY_getprotobyname 87
+#define KEY_getprotobynumber 88
+#define KEY_getprotoent 89
+#define KEY_getpwent 90
+#define KEY_getpwnam 91
+#define KEY_getpwuid 92
+#define KEY_getservbyname 93
+#define KEY_getservbyport 94
+#define KEY_getservent 95
+#define KEY_getsockname 96
+#define KEY_getsockopt 97
+#define KEY_given 98
+#define KEY_glob 99
+#define KEY_gmtime 100
+#define KEY_goto 101
+#define KEY_grep 102
+#define KEY_gt 103
+#define KEY_hex 104
+#define KEY_if 105
+#define KEY_index 106
+#define KEY_int 107
+#define KEY_ioctl 108
+#define KEY_join 109
+#define KEY_keys 110
+#define KEY_kill 111
+#define KEY_last 112
+#define KEY_lc 113
+#define KEY_lcfirst 114
+#define KEY_le 115
+#define KEY_length 116
+#define KEY_link 117
+#define KEY_listen 118
+#define KEY_local 119
+#define KEY_localtime 120
+#define KEY_lock 121
+#define KEY_log 122
+#define KEY_lstat 123
+#define KEY_lt 124
+#define KEY_m 125
+#define KEY_map 126
+#define KEY_mkdir 127
+#define KEY_msgctl 128
+#define KEY_msgget 129
+#define KEY_msgrcv 130
+#define KEY_msgsnd 131
+#define KEY_my 132
+#define KEY_ne 133
+#define KEY_next 134
+#define KEY_no 135
+#define KEY_not 136
+#define KEY_oct 137
+#define KEY_open 138
+#define KEY_opendir 139
+#define KEY_or 140
+#define KEY_ord 141
+#define KEY_our 142
+#define KEY_pack 143
+#define KEY_package 144
+#define KEY_pipe 145
+#define KEY_pop 146
+#define KEY_pos 147
+#define KEY_print 148
+#define KEY_printf 149
+#define KEY_prototype 150
+#define KEY_push 151
+#define KEY_q 152
+#define KEY_qq 153
+#define KEY_qr 154
+#define KEY_quotemeta 155
+#define KEY_qw 156
+#define KEY_qx 157
+#define KEY_rand 158
+#define KEY_read 159
+#define KEY_readdir 160
+#define KEY_readline 161
+#define KEY_readlink 162
+#define KEY_readpipe 163
+#define KEY_recv 164
+#define KEY_redo 165
+#define KEY_ref 166
+#define KEY_rename 167
+#define KEY_require 168
+#define KEY_reset 169
+#define KEY_return 170
+#define KEY_reverse 171
+#define KEY_rewinddir 172
+#define KEY_rindex 173
+#define KEY_rmdir 174
+#define KEY_s 175
+#define KEY_say 176
+#define KEY_scalar 177
+#define KEY_seek 178
+#define KEY_seekdir 179
+#define KEY_select 180
+#define KEY_semctl 181
+#define KEY_semget 182
+#define KEY_semop 183
+#define KEY_send 184
+#define KEY_setgrent 185
+#define KEY_sethostent 186
+#define KEY_setnetent 187
+#define KEY_setpgrp 188
+#define KEY_setpriority 189
+#define KEY_setprotoent 190
+#define KEY_setpwent 191
+#define KEY_setservent 192
+#define KEY_setsockopt 193
+#define KEY_shift 194
+#define KEY_shmctl 195
+#define KEY_shmget 196
+#define KEY_shmread 197
+#define KEY_shmwrite 198
+#define KEY_shutdown 199
+#define KEY_sin 200
+#define KEY_sleep 201
+#define KEY_socket 202
+#define KEY_socketpair 203
+#define KEY_sort 204
+#define KEY_splice 205
+#define KEY_split 206
+#define KEY_sprintf 207
+#define KEY_sqrt 208
+#define KEY_srand 209
+#define KEY_stat 210
+#define KEY_state 211
+#define KEY_study 212
+#define KEY_sub 213
+#define KEY_substr 214
+#define KEY_symlink 215
+#define KEY_syscall 216
+#define KEY_sysopen 217
+#define KEY_sysread 218
+#define KEY_sysseek 219
+#define KEY_system 220
+#define KEY_syswrite 221
+#define KEY_tell 222
+#define KEY_telldir 223
+#define KEY_tie 224
+#define KEY_tied 225
+#define KEY_time 226
+#define KEY_times 227
+#define KEY_tr 228
+#define KEY_truncate 229
+#define KEY_uc 230
+#define KEY_ucfirst 231
+#define KEY_umask 232
+#define KEY_undef 233
+#define KEY_unless 234
+#define KEY_unlink 235
+#define KEY_unpack 236
+#define KEY_unshift 237
+#define KEY_untie 238
+#define KEY_until 239
+#define KEY_use 240
+#define KEY_utime 241
+#define KEY_values 242
+#define KEY_vec 243
+#define KEY_wait 244
+#define KEY_waitpid 245
+#define KEY_wantarray 246
+#define KEY_warn 247
+#define KEY_when 248
+#define KEY_while 249
+#define KEY_write 250
+#define KEY_x 251
+#define KEY_xor 252
+#define KEY_y 253
/* Generated from:
- * 6563b55da87af894b79ef9d777217633eee6c7b5f352ff4c17317f562247f5fc regen/keywords.pl
+ * 370a83cf6eed30dfe61a9dc611013e1014e0c5f537dc4f3872576ba8b9ef7572 regen/keywords.pl
* ex: set ro: */
diff --git a/lib/feature.pm b/lib/feature.pm
index 459c03c506..dd44d7327d 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -7,6 +7,7 @@ my %feature = (
say => 'feature_say',
state => 'feature_state',
switch => 'feature_switch',
+ evalbytes => 'feature_evalbytes',
unicode_eval => 'feature_unieval',
unicode_strings => 'feature_unicode',
);
@@ -24,7 +25,8 @@ my %feature_bundle = (
"5.12" => [qw(say state switch unicode_strings)],
"5.13" => [qw(say state switch unicode_strings)],
"5.14" => [qw(say state switch unicode_strings)],
- "5.15" => [qw(say state switch unicode_strings unicode_eval)],
+ "5.15" => [qw(say state switch unicode_strings unicode_eval
+ evalbytes)],
);
# special case
diff --git a/op.c b/op.c
index d5f1dd91a0..fc6cd04d78 100644
--- a/op.c
+++ b/op.c
@@ -3598,6 +3598,11 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
dVAR;
OP *o;
+ if (type == -OP_ENTEREVAL) {
+ type = OP_ENTEREVAL;
+ flags |= OPpEVAL_BYTES<<8;
+ }
+
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
@@ -3640,6 +3645,11 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
dVAR;
UNOP *unop;
+ if (type == -OP_ENTEREVAL) {
+ type = OP_ENTEREVAL;
+ flags |= OPpEVAL_BYTES<<8;
+ }
+
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
@@ -7469,22 +7479,26 @@ Perl_ck_eval(pTHX_ OP *o)
}
}
else {
+ U8 priv = o->op_private;
#ifdef PERL_MAD
OP* const oldo = o;
#else
op_free(o);
#endif
- o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
+ o = newUNOP(OP_ENTEREVAL, priv <<8, newDEFSVOP());
op_getmad(oldo,o,'O');
}
o->op_targ = (PADOFFSET)PL_hints;
- if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
+ if ((PL_hints & HINT_LOCALIZE_HH) != 0
+ && !(o->op_private & OPpEVAL_COPHH) && GvHV(PL_hintgv)) {
/* Store a copy of %^H that pp_entereval can pick up. */
OP *hhop = newSVOP(OP_HINTSEVAL, 0,
MUTABLE_SV(hv_copy_hints_hv(GvHV(PL_hintgv))));
cUNOPo->op_first->op_sibling = hhop;
o->op_private |= OPpEVAL_HAS_HH;
- if (FEATURE_IS_ENABLED("unieval"))
+
+ if (!(o->op_private & OPpEVAL_BYTES)
+ && FEATURE_IS_ENABLED("unieval"))
o->op_private |= OPpEVAL_UNICODE;
}
return o;
@@ -9356,7 +9370,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
}
else {
OP *prev, *cvop;
- U32 paren;
+ U32 flags;
#ifdef PERL_MAD
bool seenarg = FALSE;
#endif
@@ -9375,16 +9389,20 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
#endif
;
prev->op_sibling = NULL;
- paren = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN);
+ flags = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN);
op_free(cvop);
if (aop == cvop) aop = NULL;
op_free(entersubop);
+ if (opnum == OP_ENTEREVAL
+ && GvNAMELEN(namegv)==9 && strnEQ(GvNAME(namegv), "evalbytes", 9))
+ flags |= OPpEVAL_BYTES <<8;
+
switch (PL_opargs[opnum] & OA_CLASS_MASK) {
case OA_UNOP:
case OA_BASEOP_OR_UNOP:
case OA_FILESTATOP:
- return aop ? newUNOP(opnum,paren,aop) : newOP(opnum,paren);
+ return aop ? newUNOP(opnum,flags,aop) : newOP(opnum,flags);
case OA_BASEOP:
if (aop) {
#ifdef PERL_MAD
@@ -10338,6 +10356,8 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
retsetpvs("+;$$@", OP_SPLICE);
case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
retsetpvs("", 0);
+ case KEY_evalbytes:
+ name = "entereval"; break;
case KEY_readpipe:
name = "backtick";
}
@@ -10435,7 +10455,11 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0)
);
case OA_BASEOP_OR_UNOP:
- o = newUNOP(opnum,0,argop);
+ if (opnum == OP_ENTEREVAL) {
+ o = newUNOP(OP_ENTEREVAL,OPpEVAL_COPHH<<8,argop);
+ if (code == -KEY_evalbytes) o->op_private |= OPpEVAL_BYTES;
+ }
+ else o = newUNOP(opnum,0,argop);
if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE;
else {
onearg:
diff --git a/op.h b/op.h
index a9ecedb8e4..f82758e46e 100644
--- a/op.h
+++ b/op.h
@@ -296,6 +296,8 @@ Deprecated. Use C<GIMME_V> instead.
/* Private for OP_ENTEREVAL */
#define OPpEVAL_HAS_HH 2 /* Does it have a copy of %^H */
#define OPpEVAL_UNICODE 4
+#define OPpEVAL_BYTES 8
+#define OPpEVAL_COPHH 16 /* Construct %^H from cop hints */
/* Private for OP_CALLER and OP_WANTARRAY */
#define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */
diff --git a/opcode.h b/opcode.h
index 34f8b48752..99b25240aa 100644
--- a/opcode.h
+++ b/opcode.h
@@ -2023,7 +2023,7 @@ EXTCONST U32 PL_opargs[] = {
0x00009bc0, /* require */
0x00001140, /* dofile */
0x00000604, /* hintseval */
- 0x00001b40, /* entereval */
+ 0x00009bc0, /* entereval */
0x00001100, /* leaveeval */
0x00000340, /* entertry */
0x00000400, /* leavetry */
diff --git a/pp_ctl.c b/pp_ctl.c
index 153d98e604..9b9bff9a8f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4131,6 +4131,11 @@ PP(pp_entereval)
if (PL_op->op_private & OPpEVAL_HAS_HH) {
saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs));
}
+ else if (PL_op->op_private & OPpEVAL_COPHH
+ && PL_curcop->cop_hints & HINT_LOCALIZE_HH) {
+ saved_hh = cop_hints_2hv(PL_curcop, 0);
+ hv_magic(saved_hh, NULL, PERL_MAGIC_hints);
+ }
sv = POPs;
if (!SvPOK(sv)) {
/* make sure we've got a plain PV (no overload etc) before testing
@@ -4140,6 +4145,15 @@ PP(pp_entereval)
const char * const p = SvPV_const(sv, len);
sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
+
+ if (PL_op->op_private & OPpEVAL_BYTES && SvUTF8(sv))
+ SvPVbyte_force(sv, len);
+ }
+ else if (PL_op->op_private & OPpEVAL_BYTES && SvUTF8(sv)) {
+ /* Don’t modify someone else’s scalar */
+ STRLEN len;
+ sv = newSVsv(sv);
+ SvPVbyte_force(sv,len);
}
TAINT_IF(SvTAINTED(sv));
@@ -4173,7 +4187,8 @@ PP(pp_entereval)
ensues, we always turn GvMULTI_on for any globals that were
introduced within evals. See force_ident(). GSAR 96-10-12 */
SAVEHINTS();
- PL_hints = PL_op->op_targ;
+ PL_hints = PL_op->op_private & OPpEVAL_COPHH
+ ? PL_curcop->cop_hints : PL_op->op_targ;
if (saved_hh) {
/* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */
SvREFCNT_dec(GvHV(PL_hintgv));
diff --git a/regen/keywords.pl b/regen/keywords.pl
index 5f7f1ef851..c4cd187273 100755
--- a/regen/keywords.pl
+++ b/regen/keywords.pl
@@ -45,6 +45,8 @@ my %feature_kw = (
say => 'say',
state => 'state',
+
+ evalbytes=>'evalbytes',
);
my %pos = map { ($_ => 1) } @{$by_strength{'+'}};
@@ -165,6 +167,7 @@ __END__
-eof
-eq
+eval
+-evalbytes
-exec
+exists
-exit
diff --git a/regen/opcodes b/regen/opcodes
index 5b988a11aa..45cf693673 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -483,7 +483,7 @@ semctl semctl ck_fun imst@ S S S S
require require ck_require du% S?
dofile do "file" ck_fun d1 S
hintseval eval hints ck_svconst s$
-entereval eval "string" ck_eval d% S
+entereval eval "string" ck_eval du% S?
leaveeval eval "string" exit ck_null 1 S
#evalonce eval constant string ck_null d1 S
entertry eval {block} ck_eval d|
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 2027f41ac5..d3f03eb58a 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -30,6 +30,7 @@ package sov {
}
my %op_desc = (
+ evalbytes=> 'eval "string"',
join => 'join or string',
readline => '<HANDLE>',
readpipe => 'quoted execution (``, qx)',
@@ -118,10 +119,11 @@ sub test_proto {
elsif ($p =~ '^([$*]+);?\z') { # Fixed-length $$$ or ***
my $args = length $1;
$tests += 2;
+ my $desc = quotemeta op_desc($o);
eval " &CORE::$o((1)x($args-1)) ";
- like $@, qr/^Not enough arguments for $o at /, "&$o with too few args";
+ like $@, qr/^Not enough arguments for $desc at /, "&$o w/too few args";
eval " &CORE::$o((1)x($args+1)) ";
- like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
+ like $@, qr/^Too many arguments for $desc at /, "&$o w/too many args";
}
elsif ($p =~ '^([$*]+);([$*]+)\z') { # Variable-length $$$ or ***
my $minargs = length $1;
@@ -396,6 +398,29 @@ test_proto $_ for qw(
endgrent endhostent endnetent endprotoent endpwent endservent
);
+test_proto 'evalbytes';
+$tests += 4;
+{
+ chop(my $upgraded = "use utf8; '\xc4\x80'" . chr 256);
+ is &myevalbytes($upgraded), chr 256, '&evalbytes';
+ # Test hints
+ require strict;
+ strict->import;
+ &myevalbytes('
+ is someone, "someone", "run-time hint bits do not leak into &evalbytes"
+ ');
+ use strict;
+ BEGIN { $^H{coreamp} = 42 }
+ $^H{coreamp} = 75;
+ &myevalbytes('
+ BEGIN {
+ is $^H{coreamp}, 42, "compile-time hh propagates into &evalbytes";
+ }
+ ${"frobnicate"}
+ ');
+ like $@, qr/strict/, 'compile-time hint bits propagate into &evalbytes';
+}
+
test_proto 'exit';
$tests ++;
is runperl(prog => '&CORE::exit; END { print qq-ok\n- }'), "ok\n",
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 60aa1b7814..1665cf6ab6 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -84,7 +84,7 @@ while(<$kh>) {
# These ops currently accept any number of args, despite their
# prototypes, if they have any:
next if $word =~ /^(?:chom?p|exec|keys|each|not|read(?:lin|pip)e
- |reset|system|values|l?stat)/x;
+ |reset|system|values|l?stat)|evalbytes/x;
$tests ++;
$code =
diff --git a/t/op/cproto.t b/t/op/cproto.t
index c9cfe466ca..ad2249df2c 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -7,7 +7,7 @@ BEGIN {
}
BEGIN { require './test.pl'; }
-plan tests => 245;
+plan tests => 246;
while (<DATA>) {
chomp;
@@ -77,6 +77,7 @@ endservent ()
eof (;*)
eq undef
eval undef
+evalbytes (_)
exec undef
exists undef
exit (;$)
diff --git a/t/op/evalbytes.t b/t/op/evalbytes.t
new file mode 100644
index 0000000000..4a60614814
--- /dev/null
+++ b/t/op/evalbytes.t
@@ -0,0 +1,34 @@
+#!./perl
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+plan(tests => 8);
+
+{
+ local $SIG{__WARN__} = sub {};
+ eval "evalbytes 'foo'";
+ like $@, qr/syntax error/, 'evalbytes outside feature scope';
+}
+
+# We enable unicode_eval just to test that it does not interfere.
+use feature 'evalbytes', 'unicode_eval';
+
+is evalbytes("1+7"), 8, 'evalbytes basic sanity check';
+
+my $code = 'qq(\xff\xfe)';
+is evalbytes($code), "\xff\xfe", 'evalbytes on extra-ASCII bytes';
+chop((my $upcode = $code) .= chr 256);
+is evalbytes($upcode), "\xff\xfe", 'evalbytes on upgraded extra-ASCII';
+{
+ use utf8;
+ is evalbytes($code), "\xff\xfe", 'evalbytes ignores outer utf8 pragma';
+}
+is evalbytes "use utf8; '\xc4\x80'", chr 256, 'use utf8 within evalbytes';
+chop($upcode = "use utf8; '\xc4\x80'" . chr 256);
+is evalbytes $upcode, chr 256, 'use utf8 within evalbytes on utf8 string';
+eval { evalbytes chr 256 };
+like $@, qr/Wide character/, 'evalbytes croaks on non-bytes';
diff --git a/toke.c b/toke.c
index 3720a83101..b1acdd3408 100644
--- a/toke.c
+++ b/toke.c
@@ -7248,6 +7248,10 @@ Perl_yylex(pTHX)
UNIBRACK(OP_ENTEREVAL);
}
+ case KEY_evalbytes:
+ PL_expect = XTERM;
+ UNIBRACK(-OP_ENTEREVAL);
+
case KEY_eof:
UNI(OP_EOF);
View Lorry Controller Status