diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | dist/B-Deparse/Deparse.pm | 3 | ||||
| -rw-r--r-- | dist/B-Deparse/t/core.t | 2 | ||||
| -rw-r--r-- | dist/B-Deparse/t/deparse.t | 1 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 4 | ||||
| -rw-r--r-- | ext/Opcode/Opcode.pm | 4 | ||||
| -rw-r--r-- | keywords.c | 41 | ||||
| -rw-r--r-- | keywords.h | 499 | ||||
| -rw-r--r-- | lib/feature.pm | 12 | ||||
| -rw-r--r-- | op.c | 3 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | opcode.h | 5 | ||||
| -rw-r--r-- | opnames.h | 3 | ||||
| -rw-r--r-- | pod/perldata.pod | 10 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 14 | ||||
| -rw-r--r-- | pp.c | 19 | ||||
| -rw-r--r-- | pp_proto.h | 1 | ||||
| -rwxr-xr-x | regen/keywords.pl | 3 | ||||
| -rw-r--r-- | regen/opcodes | 2 | ||||
| -rw-r--r-- | t/op/coreamp.t | 3 | ||||
| -rw-r--r-- | t/op/cproto.t | 3 | ||||
| -rw-r--r-- | t/op/current_sub.t | 39 | ||||
| -rw-r--r-- | toke.c | 3 |
23 files changed, 403 insertions, 274 deletions
@@ -5132,6 +5132,7 @@ t/op/coreamp.t Test &foo() calls for CORE subs t/op/coresubs.t Generics tests for CORE subs t/op/cproto.t Check builtin prototypes t/op/crypt.t See if crypt works +t/op/current_sub.t __SUB__ tests t/op/dbm.t See if dbmopen/dbmclose work t/op/defins.t See if auto-insert of defined() works t/op/delete.t See if delete works diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index cfdfc5384b..cc787a83c5 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -1547,6 +1547,7 @@ my %feature_keywords = ( default => 'switch', break => 'switch', evalbytes=>'evalbytes', + __SUB__ => '__SUB__', ); sub keyword { @@ -4361,6 +4362,8 @@ sub pp_match { matchop(@_, "m", "/") } sub pp_pushre { matchop(@_, "m", "/") } sub pp_qr { matchop(@_, "qr", "") } +sub pp_runcv { unop(@_, "__SUB__"); } + sub pp_split { my $self = shift; my($op, $cx) = @_; diff --git a/dist/B-Deparse/t/core.t b/dist/B-Deparse/t/core.t index 81d9038b8a..f5952af89c 100644 --- a/dist/B-Deparse/t/core.t +++ b/dist/B-Deparse/t/core.t @@ -26,7 +26,7 @@ my @nary = ( getgrent getlogin getc gmtime hex int lc log lstat length lcfirst localtime mkdir ord oct pop quotemeta ref rand rmdir reset reverse readlink select setpwent setgrent - shift sin sleep sqrt srand stat system tell time times + shift sin sleep sqrt srand stat __SUB__ system tell time times uc utime umask unlink ucfirst wantarray warn wait write )], # unary [qw( abs alarm bless binmode chr cos chop close chdir chomp diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index 503f46ff91..84f5f6a586 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -766,6 +766,7 @@ CORE::given ($x) { } } CORE::evalbytes ''; +() = CORE::__SUB__; #### # $#- $#+ $#{%} etc. my @x; diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 1ef9c95244..d5c869695c 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.87"; +our $VERSION = "0.88"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -660,7 +660,7 @@ if ($] >= 5.009) { $priv{$_}{2} = "GREPLEX" for ("mapwhile", "mapstart", "grepwhile", "grepstart"); } -$priv{$_}{128} = '+1' for qw "caller wantarray"; +$priv{$_}{128} = '+1' for qw "caller wantarray runcv"; @{$priv{coreargs}}{1,2,64,128} = ('DREF1','DREF2','$MOD','MARK'); our %hints; # used to display each COP's op_hints values diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index b9d9bbca47..91a7206ec7 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.21"; +$VERSION = "1.22"; use Carp; use Exporter (); @@ -543,7 +543,7 @@ This tag holds opcodes related to loading modules and getting information about calling environment and args. require dofile - caller + caller runcv =item :still_to_be_decided diff --git a/keywords.c b/keywords.c index 921d55077e..a37752f34c 100644 --- a/keywords.c +++ b/keywords.c @@ -1906,7 +1906,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) goto unknown; } - case 7: /* 29 tokens of length 7 */ + case 7: /* 30 tokens of length 7 */ switch (name[0]) { case 'D': @@ -1923,14 +1923,35 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) goto unknown; case '_': - if (name[1] == '_' && - name[2] == 'E' && - name[3] == 'N' && - name[4] == 'D' && - name[5] == '_' && - name[6] == '_') - { /* __END__ */ - return KEY___END__; + if (name[1] == '_') + { + switch (name[2]) + { + case 'E': + if (name[3] == 'N' && + name[4] == 'D' && + name[5] == '_' && + name[6] == '_') + { /* __END__ */ + return KEY___END__; + } + + goto unknown; + + case 'S': + if (name[3] == 'U' && + name[4] == 'B' && + name[5] == '_' && + name[6] == '_') + { /* __SUB__ */ + return (all_keywords || FEATURE_IS_ENABLED("__SUB__") ? -KEY___SUB__ : 0); + } + + goto unknown; + + default: + goto unknown; + } } goto unknown; @@ -3419,5 +3440,5 @@ unknown: } /* Generated from: - * 370a83cf6eed30dfe61a9dc611013e1014e0c5f537dc4f3872576ba8b9ef7572 regen/keywords.pl + * 76ce12941a02bdb120222155311eb8772ba4a4e8965a42ba347a077cac5b426e regen/keywords.pl * ex: set ro: */ diff --git a/keywords.h b/keywords.h index c33f6687c1..142ee0f939 100644 --- a/keywords.h +++ b/keywords.h @@ -19,255 +19,256 @@ #define KEY___PACKAGE__ 3 #define KEY___DATA__ 4 #define KEY___END__ 5 -#define KEY_AUTOLOAD 6 -#define KEY_BEGIN 7 -#define KEY_UNITCHECK 8 -#define KEY_CORE 9 -#define KEY_DESTROY 10 -#define KEY_END 11 -#define KEY_INIT 12 -#define KEY_CHECK 13 -#define KEY_abs 14 -#define KEY_accept 15 -#define KEY_alarm 16 -#define KEY_and 17 -#define KEY_atan2 18 -#define KEY_bind 19 -#define KEY_binmode 20 -#define KEY_bless 21 -#define KEY_break 22 -#define KEY_caller 23 -#define KEY_chdir 24 -#define KEY_chmod 25 -#define KEY_chomp 26 -#define KEY_chop 27 -#define KEY_chown 28 -#define KEY_chr 29 -#define KEY_chroot 30 -#define KEY_close 31 -#define KEY_closedir 32 -#define KEY_cmp 33 -#define KEY_connect 34 -#define KEY_continue 35 -#define KEY_cos 36 -#define KEY_crypt 37 -#define KEY_dbmclose 38 -#define KEY_dbmopen 39 -#define KEY_default 40 -#define KEY_defined 41 -#define KEY_delete 42 -#define KEY_die 43 -#define KEY_do 44 -#define KEY_dump 45 -#define KEY_each 46 -#define KEY_else 47 -#define KEY_elsif 48 -#define KEY_endgrent 49 -#define KEY_endhostent 50 -#define KEY_endnetent 51 -#define KEY_endprotoent 52 -#define KEY_endpwent 53 -#define KEY_endservent 54 -#define KEY_eof 55 -#define KEY_eq 56 -#define KEY_eval 57 -#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 +#define KEY___SUB__ 6 +#define KEY_AUTOLOAD 7 +#define KEY_BEGIN 8 +#define KEY_UNITCHECK 9 +#define KEY_CORE 10 +#define KEY_DESTROY 11 +#define KEY_END 12 +#define KEY_INIT 13 +#define KEY_CHECK 14 +#define KEY_abs 15 +#define KEY_accept 16 +#define KEY_alarm 17 +#define KEY_and 18 +#define KEY_atan2 19 +#define KEY_bind 20 +#define KEY_binmode 21 +#define KEY_bless 22 +#define KEY_break 23 +#define KEY_caller 24 +#define KEY_chdir 25 +#define KEY_chmod 26 +#define KEY_chomp 27 +#define KEY_chop 28 +#define KEY_chown 29 +#define KEY_chr 30 +#define KEY_chroot 31 +#define KEY_close 32 +#define KEY_closedir 33 +#define KEY_cmp 34 +#define KEY_connect 35 +#define KEY_continue 36 +#define KEY_cos 37 +#define KEY_crypt 38 +#define KEY_dbmclose 39 +#define KEY_dbmopen 40 +#define KEY_default 41 +#define KEY_defined 42 +#define KEY_delete 43 +#define KEY_die 44 +#define KEY_do 45 +#define KEY_dump 46 +#define KEY_each 47 +#define KEY_else 48 +#define KEY_elsif 49 +#define KEY_endgrent 50 +#define KEY_endhostent 51 +#define KEY_endnetent 52 +#define KEY_endprotoent 53 +#define KEY_endpwent 54 +#define KEY_endservent 55 +#define KEY_eof 56 +#define KEY_eq 57 +#define KEY_eval 58 +#define KEY_evalbytes 59 +#define KEY_exec 60 +#define KEY_exists 61 +#define KEY_exit 62 +#define KEY_exp 63 +#define KEY_fcntl 64 +#define KEY_fileno 65 +#define KEY_flock 66 +#define KEY_for 67 +#define KEY_foreach 68 +#define KEY_fork 69 +#define KEY_format 70 +#define KEY_formline 71 +#define KEY_ge 72 +#define KEY_getc 73 +#define KEY_getgrent 74 +#define KEY_getgrgid 75 +#define KEY_getgrnam 76 +#define KEY_gethostbyaddr 77 +#define KEY_gethostbyname 78 +#define KEY_gethostent 79 +#define KEY_getlogin 80 +#define KEY_getnetbyaddr 81 +#define KEY_getnetbyname 82 +#define KEY_getnetent 83 +#define KEY_getpeername 84 +#define KEY_getpgrp 85 +#define KEY_getppid 86 +#define KEY_getpriority 87 +#define KEY_getprotobyname 88 +#define KEY_getprotobynumber 89 +#define KEY_getprotoent 90 +#define KEY_getpwent 91 +#define KEY_getpwnam 92 +#define KEY_getpwuid 93 +#define KEY_getservbyname 94 +#define KEY_getservbyport 95 +#define KEY_getservent 96 +#define KEY_getsockname 97 +#define KEY_getsockopt 98 +#define KEY_given 99 +#define KEY_glob 100 +#define KEY_gmtime 101 +#define KEY_goto 102 +#define KEY_grep 103 +#define KEY_gt 104 +#define KEY_hex 105 +#define KEY_if 106 +#define KEY_index 107 +#define KEY_int 108 +#define KEY_ioctl 109 +#define KEY_join 110 +#define KEY_keys 111 +#define KEY_kill 112 +#define KEY_last 113 +#define KEY_lc 114 +#define KEY_lcfirst 115 +#define KEY_le 116 +#define KEY_length 117 +#define KEY_link 118 +#define KEY_listen 119 +#define KEY_local 120 +#define KEY_localtime 121 +#define KEY_lock 122 +#define KEY_log 123 +#define KEY_lstat 124 +#define KEY_lt 125 +#define KEY_m 126 +#define KEY_map 127 +#define KEY_mkdir 128 +#define KEY_msgctl 129 +#define KEY_msgget 130 +#define KEY_msgrcv 131 +#define KEY_msgsnd 132 +#define KEY_my 133 +#define KEY_ne 134 +#define KEY_next 135 +#define KEY_no 136 +#define KEY_not 137 +#define KEY_oct 138 +#define KEY_open 139 +#define KEY_opendir 140 +#define KEY_or 141 +#define KEY_ord 142 +#define KEY_our 143 +#define KEY_pack 144 +#define KEY_package 145 +#define KEY_pipe 146 +#define KEY_pop 147 +#define KEY_pos 148 +#define KEY_print 149 +#define KEY_printf 150 +#define KEY_prototype 151 +#define KEY_push 152 +#define KEY_q 153 +#define KEY_qq 154 +#define KEY_qr 155 +#define KEY_quotemeta 156 +#define KEY_qw 157 +#define KEY_qx 158 +#define KEY_rand 159 +#define KEY_read 160 +#define KEY_readdir 161 +#define KEY_readline 162 +#define KEY_readlink 163 +#define KEY_readpipe 164 +#define KEY_recv 165 +#define KEY_redo 166 +#define KEY_ref 167 +#define KEY_rename 168 +#define KEY_require 169 +#define KEY_reset 170 +#define KEY_return 171 +#define KEY_reverse 172 +#define KEY_rewinddir 173 +#define KEY_rindex 174 +#define KEY_rmdir 175 +#define KEY_s 176 +#define KEY_say 177 +#define KEY_scalar 178 +#define KEY_seek 179 +#define KEY_seekdir 180 +#define KEY_select 181 +#define KEY_semctl 182 +#define KEY_semget 183 +#define KEY_semop 184 +#define KEY_send 185 +#define KEY_setgrent 186 +#define KEY_sethostent 187 +#define KEY_setnetent 188 +#define KEY_setpgrp 189 +#define KEY_setpriority 190 +#define KEY_setprotoent 191 +#define KEY_setpwent 192 +#define KEY_setservent 193 +#define KEY_setsockopt 194 +#define KEY_shift 195 +#define KEY_shmctl 196 +#define KEY_shmget 197 +#define KEY_shmread 198 +#define KEY_shmwrite 199 +#define KEY_shutdown 200 +#define KEY_sin 201 +#define KEY_sleep 202 +#define KEY_socket 203 +#define KEY_socketpair 204 +#define KEY_sort 205 +#define KEY_splice 206 +#define KEY_split 207 +#define KEY_sprintf 208 +#define KEY_sqrt 209 +#define KEY_srand 210 +#define KEY_stat 211 +#define KEY_state 212 +#define KEY_study 213 +#define KEY_sub 214 +#define KEY_substr 215 +#define KEY_symlink 216 +#define KEY_syscall 217 +#define KEY_sysopen 218 +#define KEY_sysread 219 +#define KEY_sysseek 220 +#define KEY_system 221 +#define KEY_syswrite 222 +#define KEY_tell 223 +#define KEY_telldir 224 +#define KEY_tie 225 +#define KEY_tied 226 +#define KEY_time 227 +#define KEY_times 228 +#define KEY_tr 229 +#define KEY_truncate 230 +#define KEY_uc 231 +#define KEY_ucfirst 232 +#define KEY_umask 233 +#define KEY_undef 234 +#define KEY_unless 235 +#define KEY_unlink 236 +#define KEY_unpack 237 +#define KEY_unshift 238 +#define KEY_untie 239 +#define KEY_until 240 +#define KEY_use 241 +#define KEY_utime 242 +#define KEY_values 243 +#define KEY_vec 244 +#define KEY_wait 245 +#define KEY_waitpid 246 +#define KEY_wantarray 247 +#define KEY_warn 248 +#define KEY_when 249 +#define KEY_while 250 +#define KEY_write 251 +#define KEY_x 252 +#define KEY_xor 253 +#define KEY_y 254 /* Generated from: - * 370a83cf6eed30dfe61a9dc611013e1014e0c5f537dc4f3872576ba8b9ef7572 regen/keywords.pl + * 76ce12941a02bdb120222155311eb8772ba4a4e8965a42ba347a077cac5b426e regen/keywords.pl * ex: set ro: */ diff --git a/lib/feature.pm b/lib/feature.pm index ce73e2df96..c48b4e39f8 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -1,6 +1,6 @@ package feature; -our $VERSION = '1.23'; +our $VERSION = '1.24'; # (feature name) => (internal name, used in %^H) my %feature = ( @@ -8,6 +8,7 @@ my %feature = ( state => 'feature_state', switch => 'feature_switch', evalbytes => 'feature_evalbytes', + current_sub => 'feature___SUB__', unicode_eval => 'feature_unieval', unicode_strings => 'feature_unicode', ); @@ -23,7 +24,7 @@ our %feature_bundle = ( "5.10" => [qw(say state switch)], "5.11" => [qw(say state switch unicode_strings)], "5.15" => [qw(say state switch unicode_strings unicode_eval - evalbytes)], + evalbytes current_sub)], ); # Each of these is the same as the previous bundle @@ -178,6 +179,13 @@ C<evalbytes> fixes that to work the way one would expect: These two features are available starting with Perl 5.16. +=head2 The 'current_sub' feature + +This provides the C<__SUB__> token that returns a reference to the current +subroutine or C<undef> outside of a subroutine. + +This feature is available starting with Perl 5.16. + =head1 FEATURE BUNDLES It's possible to load a whole slew of features in one go, using @@ -10529,7 +10529,8 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code, return op_append_elem( OP_LINESEQ, argop, newOP(opnum, - opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0) + opnum == OP_WANTARRAY || opnum == OP_RUNCV + ? OPpOFFBYONE << 8 : 0) ); case OA_BASEOP_OR_UNOP: if (opnum == OP_ENTEREVAL) { @@ -299,7 +299,7 @@ Deprecated. Use C<GIMME_V> instead. #define OPpEVAL_BYTES 8 #define OPpEVAL_COPHH 16 /* Construct %^H from cop hints */ -/* Private for OP_CALLER and OP_WANTARRAY */ +/* Private for OP_CALLER, OP_WANTARRAY and OP_RUNCV */ #define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */ /* Private for OP_COREARGS */ @@ -520,6 +520,7 @@ EXTCONST char* const PL_op_name[] = { "rkeys", "rvalues", "coreargs", + "runcv", }; #endif @@ -899,6 +900,7 @@ EXTCONST char* const PL_op_desc[] = { "keys on reference", "values on reference", "CORE:: subroutine", + "__SUB__", }; #endif @@ -1292,6 +1294,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_rkeys, Perl_pp_rvalues, /* implemented by Perl_pp_rkeys */ Perl_pp_coreargs, + Perl_pp_runcv, } #endif #ifdef PERL_PPADDR_INITED @@ -1682,6 +1685,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_each, /* rkeys */ Perl_ck_each, /* rvalues */ Perl_ck_null, /* coreargs */ + Perl_ck_null, /* runcv */ } #endif #ifdef PERL_CHECK_INITED @@ -2066,6 +2070,7 @@ EXTCONST U32 PL_opargs[] = { 0x00001b08, /* rkeys */ 0x00001b08, /* rvalues */ 0x00000600, /* coreargs */ + 0x00000004, /* runcv */ }; #endif @@ -386,10 +386,11 @@ typedef enum opcode { OP_RKEYS = 369, OP_RVALUES = 370, OP_COREARGS = 371, + OP_RUNCV = 372, OP_max } opcode; -#define MAXO 372 +#define MAXO 373 /* the OP_IS_* macros are optimized to a simple range check because all the member OPs are contiguous in regen/opcodes table. diff --git a/pod/perldata.pod b/pod/perldata.pod index 7899e396e0..16ceb41048 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -398,12 +398,16 @@ X<end> X<data> X<^D> X<^Z> The special literals __FILE__, __LINE__, and __PACKAGE__ represent the current filename, line number, and package name at that -point in your program. They may be used only as separate tokens; they +point in your program. __SUB__ gives a reference to the current +subroutine. They may be used only as separate tokens; they will not be interpolated into strings. If there is no current package (due to an empty C<package;> directive), __PACKAGE__ is the undefined value. (But the empty C<package;> is no longer supported, as of version -5.10.) -X<__FILE__> X<__LINE__> X<__PACKAGE__> X<line> X<file> X<package> +5.10.) Outside of a subroutine, __SUB__ is the undefined value. __SUB__ +is only available in 5.16 or higher, and only with a C<use v5.16> or +C<use feature "current_sub"> declaration. +X<__FILE__> X<__LINE__> X<__PACKAGE__> X<__SUB__> +X<line> X<file> X<package> The two control characters ^D and ^Z, and the tokens __END__ and __DATA__ may be used to indicate the logical end of the script before the actual diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 86770fd84a..f59ffdc744 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -164,7 +164,10 @@ X<control flow> C<caller>, C<continue>, C<die>, C<do>, C<dump>, C<eval>, C<evalbytes> C<exit>, C<__FILE__>, C<goto>, C<last>, C<__LINE__>, C<next>, C<__PACKAGE__>, -C<redo>, C<return>, C<sub>, C<wantarray>, +C<redo>, C<return>, C<sub>, C<__SUB__>, C<wantarray> + +C<__SUB__> is only available with a C<use v5.16> (or higher) declaration or +with the C<"current_sub"> feature (see L<feature>). =item Keywords related to the switch feature @@ -6908,6 +6911,15 @@ information about attributes. =item substr EXPR,OFFSET,LENGTH,REPLACEMENT X<substr> X<substring> X<mid> X<left> X<right> +=item __SUB__ +X<__SUB__> + +A special token that returns the a reference to the current subroutine, or +C<undef> outside of a subroutine. + +This token is only available under C<use v5.16> or the "current_sub" +feature. See L<feature>. + =item substr EXPR,OFFSET,LENGTH =item substr EXPR,OFFSET @@ -5794,6 +5794,25 @@ PP(pp_coreargs) RETURN; } +PP(pp_runcv) +{ + dSP; + CV *cv; + if (PL_op->op_private & OPpOFFBYONE) { + PERL_SI * const oldsi = PL_curstackinfo; + I32 const oldcxix = oldsi->si_cxix; + if (oldcxix) oldsi->si_cxix--; + else PL_curstackinfo = oldsi->si_prev; + cv = find_runcv(NULL); + PL_curstackinfo = oldsi; + oldsi->si_cxix = oldcxix; + } + else cv = find_runcv(NULL); + XPUSHs(CvUNIQUE(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv))); + RETURN; +} + + /* * Local variables: * c-indentation-style: bsd diff --git a/pp_proto.h b/pp_proto.h index bc4622b2cc..96bcacbe6b 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -199,6 +199,7 @@ PERL_CALLCONV OP *Perl_pp_rewinddir(pTHX); PERL_CALLCONV OP *Perl_pp_right_shift(pTHX); PERL_CALLCONV OP *Perl_pp_rkeys(pTHX); PERL_CALLCONV OP *Perl_pp_rmdir(pTHX); +PERL_CALLCONV OP *Perl_pp_runcv(pTHX); PERL_CALLCONV OP *Perl_pp_rv2av(pTHX); PERL_CALLCONV OP *Perl_pp_rv2cv(pTHX); PERL_CALLCONV OP *Perl_pp_rv2gv(pTHX); diff --git a/regen/keywords.pl b/regen/keywords.pl index c4cd187273..2cfc5d8641 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -47,6 +47,8 @@ my %feature_kw = ( state => 'state', evalbytes=>'evalbytes', + + __SUB__ => '__SUB__', ); my %pos = map { ($_ => 1) } @{$by_strength{'+'}}; @@ -115,6 +117,7 @@ __END__ -__PACKAGE__ +__DATA__ +__END__ +-__SUB__ +AUTOLOAD +BEGIN +UNITCHECK diff --git a/regen/opcodes b/regen/opcodes index f75411e398..c7b42c40a0 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -543,3 +543,5 @@ rvalues values on reference ck_each t% S # For CORE:: subs coreargs CORE:: subroutine ck_null $ + +runcv __SUB__ ck_null s0 diff --git a/t/op/coreamp.t b/t/op/coreamp.t index d3f03eb58a..4285157fe7 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -235,10 +235,13 @@ sub test_proto { test_proto '__FILE__'; test_proto '__LINE__'; test_proto '__PACKAGE__'; +test_proto '__SUB__'; is file(), 'frob' , '__FILE__ does check its caller' ; ++ $tests; is line(), 5 , '__LINE__ does check its caller' ; ++ $tests; is pakg(), 'stribble', '__PACKAGE__ does check its caller'; ++ $tests; +sub __SUB__test { &my__SUB__ } +is __SUB__test, \&__SUB__test, '&__SUB__'; ++ $tests; test_proto 'abs', -5, 5; diff --git a/t/op/cproto.t b/t/op/cproto.t index ad2249df2c..dabb4bc4a6 100644 --- a/t/op/cproto.t +++ b/t/op/cproto.t @@ -7,7 +7,7 @@ BEGIN { } BEGIN { require './test.pl'; } -plan tests => 246; +plan tests => 247; while (<DATA>) { chomp; @@ -32,6 +32,7 @@ __LINE__ () __PACKAGE__ () __DATA__ undef __END__ undef +__SUB__ () CORE unknown abs (_) accept (**) diff --git a/t/op/current_sub.t b/t/op/current_sub.t new file mode 100644 index 0000000000..7a00032c46 --- /dev/null +++ b/t/op/current_sub.t @@ -0,0 +1,39 @@ +#!./perl + +BEGIN { + chdir 't'; + @INC = qw(../lib); + require './test.pl'; +} + +plan tests => 11; + +is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature'; + +{ + use v5.15; + is __SUB__, undef, '__SUB__ under use v5.16'; +} + +use feature 'current_sub'; + +is __SUB__, undef, '__SUB__ returns undef outside of a subroutine'; +is +()=__SUB__, 1, '__SUB__ returns undef in list context'; + +sub foo { __SUB__ } +is foo, \&foo, '__SUB__ inside a named subroutine'; +is foo->(), \&foo, '__SUB__ is callable'; +is ref foo, 'CODE', '__SUB__ is a code reference'; + +my $subsub = sub { __SUB__ }; +is &$subsub, $subsub, '__SUB__ inside anonymous non-closure'; + +my @subsubs; +for my $x(1..3) { + push @subsubs, sub { return $x if @_; __SUB__ }; +} +# Don’t loop here; we need to avoid interactions between the iterator +# and the closure. +is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)'; +is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)'; +is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)'; @@ -7119,6 +7119,9 @@ Perl_yylex(pTHX) goto fake_eof; } + case KEY___SUB__: + FUN0(OP_RUNCV); + case KEY_AUTOLOAD: case KEY_DESTROY: case KEY_BEGIN: |