mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
Add evalbytes function
This function evaluates its argument as a byte string, regardless of
the internal encoding. It croaks if the string contains characters
outside the byte range. Hence evalbytes(" use utf8; '\xc4\x80' ")
will return "\x{100}", even if the original string had the UTF8 flag
on, and evalbytes(" '\xc4\x80' ") will return "\xc4\x80".
This has the side effect of fixing the deparsing of CORE::break under
‘use feature’ when there is an override.
This commit is contained in:
Father Chrysostomos
parent
17e00314ca
commit
7d7892821c
1
MANIFEST
1
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
|
||||
|
||||
23
dist/B-Deparse/Deparse.pm
vendored
23
dist/B-Deparse/Deparse.pm
vendored
@ -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") }
|
||||
|
||||
7
dist/B-Deparse/t/core.t
vendored
7
dist/B-Deparse/t/core.t
vendored
@ -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
|
||||
|
||||
1
dist/B-Deparse/t/deparse.t
vendored
1
dist/B-Deparse/t/deparse.t
vendored
@ -765,6 +765,7 @@ CORE::given ($x) {
|
||||
CORE::break;
|
||||
}
|
||||
}
|
||||
CORE::evalbytes '';
|
||||
####
|
||||
# $#- $#+ $#{%} etc.
|
||||
my @x;
|
||||
|
||||
@ -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
|
||||
],
|
||||
|
||||
48
keywords.c
48
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: */
|
||||
|
||||
393
keywords.h
393
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: */
|
||||
|
||||
@ -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
|
||||
|
||||
38
op.c
38
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:
|
||||
|
||||
2
op.h
2
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) */
|
||||
|
||||
2
opcode.h
2
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 */
|
||||
|
||||
17
pp_ctl.c
17
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));
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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|
|
||||
|
||||
@ -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",
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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 (;$)
|
||||
|
||||
34
t/op/evalbytes.t
Normal file
34
t/op/evalbytes.t
Normal file
@ -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';
|
||||
Loading…
x
Reference in New Issue
Block a user