[perl #80628] __SUB__
authorFather Chrysostomos <sprout@cpan.org>
Tue, 22 Nov 2011 07:43:17 +0000 (23:43 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 22 Nov 2011 08:07:20 +0000 (00:07 -0800)
After much alternation, altercation and alteration, __SUB__ is
finally here.

23 files changed:
MANIFEST
dist/B-Deparse/Deparse.pm
dist/B-Deparse/t/core.t
dist/B-Deparse/t/deparse.t
ext/B/B/Concise.pm
ext/Opcode/Opcode.pm
keywords.c
keywords.h
lib/feature.pm
op.c
op.h
opcode.h
opnames.h
pod/perldata.pod
pod/perlfunc.pod
pp.c
pp_proto.h
regen/keywords.pl
regen/opcodes
t/op/coreamp.t
t/op/cproto.t
t/op/current_sub.t [new file with mode: 0644]
toke.c

index 40dc175..5f902ff 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index cfdfc53..cc787a8 100644 (file)
@@ -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) = @_;
index 81d9038..f5952af 100644 (file)
@@ -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
index 503f46f..84f5f6a 100644 (file)
@@ -766,6 +766,7 @@ CORE::given ($x) {
     }
 }
 CORE::evalbytes '';
+() = CORE::__SUB__;
 ####
 # $#- $#+ $#{%} etc.
 my @x;
index 1ef9c95..d5c8696 100644 (file)
@@ -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
index b9d9bbc..91a7206 100644 (file)
@@ -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
 
index 921d550..a37752f 100644 (file)
@@ -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: */
index c33f668..142ee0f 100644 (file)
 #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: */
index ce73e2d..c48b4e3 100644 (file)
@@ -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
diff --git a/op.c b/op.c
index ea0372d..1b7a532 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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) {
diff --git a/op.h b/op.h
index f82758e..958529e 100644 (file)
--- a/op.h
+++ b/op.h
@@ -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 */
index a1b9d2e..d747d9a 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -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
 
index 26dfbaa..5d855ec 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -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.
index 7899e39..16ceb41 100644 (file)
@@ -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
index 86770fd..f59ffdc 100644 (file)
@@ -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
diff --git a/pp.c b/pp.c
index 7011ecf..27d6a00 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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
index bc4622b..96bcacb 100644 (file)
@@ -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);
index c4cd187..2cfc5d8 100755 (executable)
@@ -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
index f75411e..c7b42c4 100644 (file)
@@ -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
index d3f03eb..4285157 100644 (file)
@@ -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;
 
index ad2249d..dabb4bc 100644 (file)
@@ -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 (file)
index 0000000..7a00032
--- /dev/null
@@ -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)';
diff --git a/toke.c b/toke.c
index 8690877..7b5c465 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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: