From 0593b621077735ec9f32581a3602e97db788a42e Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Thu, 22 Jun 2023 20:39:06 +0100 Subject: [PATCH] Added __CLASS__ keyword, which yields the runtime class name of the invoking instance --- class.c | 23 + embed.h | 55 +- ext/Opcode/Opcode.pm | 4 +- ext/Pod-Functions/t/Functions.t | 4 +- keywords.c | 23 +- keywords.h | 527 +++++++++---------- lib/B/Deparse-core.t | 1 + op.c | 3 + opcode.h | 7 + opnames.h | 3 +- pod/perlclass.pod | 21 + pod/perldiag.pod | 7 + pod/perlfunc.pod | 32 ++ pp_proto.h | 1 + proto.h | 861 ++++++++++++++++---------------- regen/embed_lib.pl | 2 +- regen/keywords.pl | 2 + regen/opcodes | 2 + t/class/class.t | 4 + t/class/inherit.t | 4 + t/lib/croak/class | 9 + t/op/coreamp.t | 1 + t/op/coresubs.t | 26 +- toke.c | 3 + 24 files changed, 894 insertions(+), 731 deletions(-) diff --git a/class.c b/class.c index 02c6c06bb47e..8de2496487ed 100644 --- a/class.c +++ b/class.c @@ -1059,6 +1059,29 @@ Perl_class_add_ADJUST(pTHX_ HV *stash, CV *cv) av_push(aux->xhv_class_adjust_blocks, (SV *)cv); } +OP * +Perl_ck_classname(pTHX_ OP *o) +{ + if(!CvIsMETHOD(PL_compcv)) + croak("Cannot use __CLASS__ outside of a method or field initializer expression"); + + return o; +} + +PP(pp_classname) +{ + dSP; + + SV *self = PAD_SVl(PADIX_SELF); + assert(SvTYPE(SvRV(self)) == SVt_PVOBJ); + + EXTEND(SP, 1); + PUSHs(sv_newmortal()); + sv_ref(*SP, SvRV(self), true); + + RETURN; +} + /* * ex: set ts=8 sts=4 sw=4 et: */ diff --git a/embed.h b/embed.h index 40f13087cf31..2ccd3058844e 100644 --- a/embed.h +++ b/embed.h @@ -1155,34 +1155,12 @@ # if defined(PERL_IN_AV_C) # define get_aux_mg(a) S_get_aux_mg(aTHX_ a) # endif -# if defined(PERL_IN_DEB_C) -# define deb_stack_n(a,b,c,d,e) S_deb_stack_n(aTHX_ a,b,c,d,e) -# endif -# if defined(PERL_IN_DOIO_C) -# define argvout_final(a,b,c) S_argvout_final(aTHX_ a,b,c) -# define exec_failed(a,b,c) S_exec_failed(aTHX_ a,b,c) -# define ingroup(a,b) S_ingroup(aTHX_ a,b) -# define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l,m) -# define openn_setup(a,b,c,d,e,f) S_openn_setup(aTHX_ a,b,c,d,e,f) -# endif -# if defined(PERL_IN_DOOP_C) -# define do_trans_complex(a,b) S_do_trans_complex(aTHX_ a,b) -# define do_trans_count(a,b) S_do_trans_count(aTHX_ a,b) -# define do_trans_count_invmap(a,b) S_do_trans_count_invmap(aTHX_ a,b) -# define do_trans_invmap(a,b) S_do_trans_invmap(aTHX_ a,b) -# define do_trans_simple(a,b) S_do_trans_simple(aTHX_ a,b) -# endif -# if defined(PERL_IN_DUMP_C) -# define deb_curcv(a) S_deb_curcv(aTHX_ a) -# define debprof(a) S_debprof(aTHX_ a) -# define pm_description(a) S_pm_description(aTHX_ a) -# define sequence_num(a) S_sequence_num(aTHX_ a) -# endif -# if defined(PERL_IN_GLOBALS_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_PEEP_C) +# if defined(PERL_IN_CLASS_C) || defined(PERL_IN_GLOBALS_C) || \ + defined(PERL_IN_OP_C) || defined(PERL_IN_PEEP_C) # define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) # define ck_backtick(a) Perl_ck_backtick(aTHX_ a) # define ck_bitop(a) Perl_ck_bitop(aTHX_ a) +# define ck_classname(a) Perl_ck_classname(aTHX_ a) # define ck_cmp(a) Perl_ck_cmp(aTHX_ a) # define ck_concat(a) Perl_ck_concat(aTHX_ a) # define ck_defined(a) Perl_ck_defined(aTHX_ a) @@ -1229,8 +1207,31 @@ # define ck_tell(a) Perl_ck_tell(aTHX_ a) # define ck_trunc(a) Perl_ck_trunc(aTHX_ a) # define ck_trycatch(a) Perl_ck_trycatch(aTHX_ a) -# endif /* defined(PERL_IN_GLOBALS_C) || defined(PERL_IN_OP_C) || - defined(PERL_IN_PEEP_C) */ +# endif /* defined(PERL_IN_CLASS_C) || defined(PERL_IN_GLOBALS_C) || + defined(PERL_IN_OP_C) || defined(PERL_IN_PEEP_C) */ +# if defined(PERL_IN_DEB_C) +# define deb_stack_n(a,b,c,d,e) S_deb_stack_n(aTHX_ a,b,c,d,e) +# endif +# if defined(PERL_IN_DOIO_C) +# define argvout_final(a,b,c) S_argvout_final(aTHX_ a,b,c) +# define exec_failed(a,b,c) S_exec_failed(aTHX_ a,b,c) +# define ingroup(a,b) S_ingroup(aTHX_ a,b) +# define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l,m) +# define openn_setup(a,b,c,d,e,f) S_openn_setup(aTHX_ a,b,c,d,e,f) +# endif +# if defined(PERL_IN_DOOP_C) +# define do_trans_complex(a,b) S_do_trans_complex(aTHX_ a,b) +# define do_trans_count(a,b) S_do_trans_count(aTHX_ a,b) +# define do_trans_count_invmap(a,b) S_do_trans_count_invmap(aTHX_ a,b) +# define do_trans_invmap(a,b) S_do_trans_invmap(aTHX_ a,b) +# define do_trans_simple(a,b) S_do_trans_simple(aTHX_ a,b) +# endif +# if defined(PERL_IN_DUMP_C) +# define deb_curcv(a) S_deb_curcv(aTHX_ a) +# define debprof(a) S_debprof(aTHX_ a) +# define pm_description(a) S_pm_description(aTHX_ a) +# define sequence_num(a) S_sequence_num(aTHX_ a) +# endif # if defined(PERL_IN_GV_C) # define find_default_stash(a,b,c,d,e,f) S_find_default_stash(aTHX_ a,b,c,d,e,f) # define gv_fetchmeth_internal(a,b,c,d,e,f) S_gv_fetchmeth_internal(aTHX_ a,b,c,d,e,f) diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index b4aead9e401a..c7820c172873 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -1,4 +1,4 @@ -package Opcode 1.64; +package Opcode 1.65; use strict; @@ -567,7 +567,7 @@ This tag holds opcodes related to loading modules and getting information about calling environment and args. require dofile - caller runcv + caller runcv classname =item :still_to_be_decided diff --git a/ext/Pod-Functions/t/Functions.t b/ext/Pod-Functions/t/Functions.t index 089569d44bf3..ee3c3d3eaf2c 100644 --- a/ext/Pod-Functions/t/Functions.t +++ b/ext/Pod-Functions/t/Functions.t @@ -133,8 +133,8 @@ Keywords related to Perl modules: do, import, no, package, require, use Keywords related to classes and object-orientation: - bless, class, dbmclose, dbmopen, field, method, package, - ref, tie, tied, untie, use + __CLASS__, bless, class, dbmclose, dbmopen, field, method, + package, ref, tie, tied, untie, use Low-level socket functions: accept, bind, connect, getpeername, getsockname, diff --git a/keywords.c b/keywords.c index 54f5d94fd192..50870579b8e3 100644 --- a/keywords.c +++ b/keywords.c @@ -1,4 +1,4 @@ -/* -*- buffer-read-only: t -*- +/* -*- mode: C; buffer-read-only: t -*- * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! * This file is built by regen/keywords.pl from its data. * Any changes made here will be lost! @@ -2879,7 +2879,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) goto unknown; } - case 9: /* 10 tokens of length 9 */ + case 9: /* 11 tokens of length 9 */ switch (name[0]) { case 'U': @@ -2897,6 +2897,21 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) goto unknown; + case '_': + if (name[1] == '_' && + name[2] == 'C' && + name[3] == 'L' && + name[4] == 'A' && + name[5] == 'S' && + name[6] == 'S' && + name[7] == '_' && + name[8] == '_') + { /* __CLASS__ */ + return (all_keywords || FEATURE_CLASS_IS_ENABLED ? -KEY___CLASS__ : 0); + } + + goto unknown; + case 'e': switch (name[1]) { @@ -3558,5 +3573,5 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) } /* Generated from: - * eb67e851da14ede1aad67aec4a387fa250c1345407fad0a02988d2d8d3cc27f2 regen/keywords.pl - * ex: set ro: */ + * c8b75109fa56ce3ea3f30503a3b398f02e49036dc60d5fb36ea5ba9ffd6c596e regen/keywords.pl + * ex: set ro ft=c: */ diff --git a/keywords.h b/keywords.h index feae6f6dce7a..72c6d874c90b 100644 --- a/keywords.h +++ b/keywords.h @@ -1,4 +1,4 @@ -/* -*- buffer-read-only: t -*- +/* -*- mode: C; buffer-read-only: t -*- * * keywords.h * @@ -17,267 +17,268 @@ #define KEY___FILE__ 1 #define KEY___LINE__ 2 #define KEY___PACKAGE__ 3 -#define KEY___DATA__ 4 -#define KEY___END__ 5 -#define KEY___SUB__ 6 -#define KEY_ADJUST 7 -#define KEY_AUTOLOAD 8 -#define KEY_BEGIN 9 -#define KEY_UNITCHECK 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_catch 25 -#define KEY_chdir 26 -#define KEY_chmod 27 -#define KEY_chomp 28 -#define KEY_chop 29 -#define KEY_chown 30 -#define KEY_chr 31 -#define KEY_chroot 32 -#define KEY_class 33 -#define KEY_close 34 -#define KEY_closedir 35 -#define KEY_cmp 36 -#define KEY_connect 37 -#define KEY_continue 38 -#define KEY_cos 39 -#define KEY_crypt 40 -#define KEY_dbmclose 41 -#define KEY_dbmopen 42 -#define KEY_default 43 -#define KEY_defer 44 -#define KEY_defined 45 -#define KEY_delete 46 -#define KEY_die 47 -#define KEY_do 48 -#define KEY_dump 49 -#define KEY_each 50 -#define KEY_else 51 -#define KEY_elsif 52 -#define KEY_endgrent 53 -#define KEY_endhostent 54 -#define KEY_endnetent 55 -#define KEY_endprotoent 56 -#define KEY_endpwent 57 -#define KEY_endservent 58 -#define KEY_eof 59 -#define KEY_eq 60 -#define KEY_eval 61 -#define KEY_evalbytes 62 -#define KEY_exec 63 -#define KEY_exists 64 -#define KEY_exit 65 -#define KEY_exp 66 -#define KEY_fc 67 -#define KEY_fcntl 68 -#define KEY_field 69 -#define KEY_fileno 70 -#define KEY_finally 71 -#define KEY_flock 72 -#define KEY_for 73 -#define KEY_foreach 74 -#define KEY_fork 75 -#define KEY_format 76 -#define KEY_formline 77 -#define KEY_ge 78 -#define KEY_getc 79 -#define KEY_getgrent 80 -#define KEY_getgrgid 81 -#define KEY_getgrnam 82 -#define KEY_gethostbyaddr 83 -#define KEY_gethostbyname 84 -#define KEY_gethostent 85 -#define KEY_getlogin 86 -#define KEY_getnetbyaddr 87 -#define KEY_getnetbyname 88 -#define KEY_getnetent 89 -#define KEY_getpeername 90 -#define KEY_getpgrp 91 -#define KEY_getppid 92 -#define KEY_getpriority 93 -#define KEY_getprotobyname 94 -#define KEY_getprotobynumber 95 -#define KEY_getprotoent 96 -#define KEY_getpwent 97 -#define KEY_getpwnam 98 -#define KEY_getpwuid 99 -#define KEY_getservbyname 100 -#define KEY_getservbyport 101 -#define KEY_getservent 102 -#define KEY_getsockname 103 -#define KEY_getsockopt 104 -#define KEY_given 105 -#define KEY_glob 106 -#define KEY_gmtime 107 -#define KEY_goto 108 -#define KEY_grep 109 -#define KEY_gt 110 -#define KEY_hex 111 -#define KEY_if 112 -#define KEY_index 113 -#define KEY_int 114 -#define KEY_ioctl 115 -#define KEY_isa 116 -#define KEY_join 117 -#define KEY_keys 118 -#define KEY_kill 119 -#define KEY_last 120 -#define KEY_lc 121 -#define KEY_lcfirst 122 -#define KEY_le 123 -#define KEY_length 124 -#define KEY_link 125 -#define KEY_listen 126 -#define KEY_local 127 -#define KEY_localtime 128 -#define KEY_lock 129 -#define KEY_log 130 -#define KEY_lstat 131 -#define KEY_lt 132 -#define KEY_m 133 -#define KEY_map 134 -#define KEY_method 135 -#define KEY_mkdir 136 -#define KEY_msgctl 137 -#define KEY_msgget 138 -#define KEY_msgrcv 139 -#define KEY_msgsnd 140 -#define KEY_my 141 -#define KEY_ne 142 -#define KEY_next 143 -#define KEY_no 144 -#define KEY_not 145 -#define KEY_oct 146 -#define KEY_open 147 -#define KEY_opendir 148 -#define KEY_or 149 -#define KEY_ord 150 -#define KEY_our 151 -#define KEY_pack 152 -#define KEY_package 153 -#define KEY_pipe 154 -#define KEY_pop 155 -#define KEY_pos 156 -#define KEY_print 157 -#define KEY_printf 158 -#define KEY_prototype 159 -#define KEY_push 160 -#define KEY_q 161 -#define KEY_qq 162 -#define KEY_qr 163 -#define KEY_quotemeta 164 -#define KEY_qw 165 -#define KEY_qx 166 -#define KEY_rand 167 -#define KEY_read 168 -#define KEY_readdir 169 -#define KEY_readline 170 -#define KEY_readlink 171 -#define KEY_readpipe 172 -#define KEY_recv 173 -#define KEY_redo 174 -#define KEY_ref 175 -#define KEY_rename 176 -#define KEY_require 177 -#define KEY_reset 178 -#define KEY_return 179 -#define KEY_reverse 180 -#define KEY_rewinddir 181 -#define KEY_rindex 182 -#define KEY_rmdir 183 -#define KEY_s 184 -#define KEY_say 185 -#define KEY_scalar 186 -#define KEY_seek 187 -#define KEY_seekdir 188 -#define KEY_select 189 -#define KEY_semctl 190 -#define KEY_semget 191 -#define KEY_semop 192 -#define KEY_send 193 -#define KEY_setgrent 194 -#define KEY_sethostent 195 -#define KEY_setnetent 196 -#define KEY_setpgrp 197 -#define KEY_setpriority 198 -#define KEY_setprotoent 199 -#define KEY_setpwent 200 -#define KEY_setservent 201 -#define KEY_setsockopt 202 -#define KEY_shift 203 -#define KEY_shmctl 204 -#define KEY_shmget 205 -#define KEY_shmread 206 -#define KEY_shmwrite 207 -#define KEY_shutdown 208 -#define KEY_sin 209 -#define KEY_sleep 210 -#define KEY_socket 211 -#define KEY_socketpair 212 -#define KEY_sort 213 -#define KEY_splice 214 -#define KEY_split 215 -#define KEY_sprintf 216 -#define KEY_sqrt 217 -#define KEY_srand 218 -#define KEY_stat 219 -#define KEY_state 220 -#define KEY_study 221 -#define KEY_sub 222 -#define KEY_substr 223 -#define KEY_symlink 224 -#define KEY_syscall 225 -#define KEY_sysopen 226 -#define KEY_sysread 227 -#define KEY_sysseek 228 -#define KEY_system 229 -#define KEY_syswrite 230 -#define KEY_tell 231 -#define KEY_telldir 232 -#define KEY_tie 233 -#define KEY_tied 234 -#define KEY_time 235 -#define KEY_times 236 -#define KEY_tr 237 -#define KEY_try 238 -#define KEY_truncate 239 -#define KEY_uc 240 -#define KEY_ucfirst 241 -#define KEY_umask 242 -#define KEY_undef 243 -#define KEY_unless 244 -#define KEY_unlink 245 -#define KEY_unpack 246 -#define KEY_unshift 247 -#define KEY_untie 248 -#define KEY_until 249 -#define KEY_use 250 -#define KEY_utime 251 -#define KEY_values 252 -#define KEY_vec 253 -#define KEY_wait 254 -#define KEY_waitpid 255 -#define KEY_wantarray 256 -#define KEY_warn 257 -#define KEY_when 258 -#define KEY_while 259 -#define KEY_write 260 -#define KEY_x 261 -#define KEY_xor 262 -#define KEY_y 263 +#define KEY___CLASS__ 4 +#define KEY___DATA__ 5 +#define KEY___END__ 6 +#define KEY___SUB__ 7 +#define KEY_ADJUST 8 +#define KEY_AUTOLOAD 9 +#define KEY_BEGIN 10 +#define KEY_UNITCHECK 11 +#define KEY_DESTROY 12 +#define KEY_END 13 +#define KEY_INIT 14 +#define KEY_CHECK 15 +#define KEY_abs 16 +#define KEY_accept 17 +#define KEY_alarm 18 +#define KEY_and 19 +#define KEY_atan2 20 +#define KEY_bind 21 +#define KEY_binmode 22 +#define KEY_bless 23 +#define KEY_break 24 +#define KEY_caller 25 +#define KEY_catch 26 +#define KEY_chdir 27 +#define KEY_chmod 28 +#define KEY_chomp 29 +#define KEY_chop 30 +#define KEY_chown 31 +#define KEY_chr 32 +#define KEY_chroot 33 +#define KEY_class 34 +#define KEY_close 35 +#define KEY_closedir 36 +#define KEY_cmp 37 +#define KEY_connect 38 +#define KEY_continue 39 +#define KEY_cos 40 +#define KEY_crypt 41 +#define KEY_dbmclose 42 +#define KEY_dbmopen 43 +#define KEY_default 44 +#define KEY_defer 45 +#define KEY_defined 46 +#define KEY_delete 47 +#define KEY_die 48 +#define KEY_do 49 +#define KEY_dump 50 +#define KEY_each 51 +#define KEY_else 52 +#define KEY_elsif 53 +#define KEY_endgrent 54 +#define KEY_endhostent 55 +#define KEY_endnetent 56 +#define KEY_endprotoent 57 +#define KEY_endpwent 58 +#define KEY_endservent 59 +#define KEY_eof 60 +#define KEY_eq 61 +#define KEY_eval 62 +#define KEY_evalbytes 63 +#define KEY_exec 64 +#define KEY_exists 65 +#define KEY_exit 66 +#define KEY_exp 67 +#define KEY_fc 68 +#define KEY_fcntl 69 +#define KEY_field 70 +#define KEY_fileno 71 +#define KEY_finally 72 +#define KEY_flock 73 +#define KEY_for 74 +#define KEY_foreach 75 +#define KEY_fork 76 +#define KEY_format 77 +#define KEY_formline 78 +#define KEY_ge 79 +#define KEY_getc 80 +#define KEY_getgrent 81 +#define KEY_getgrgid 82 +#define KEY_getgrnam 83 +#define KEY_gethostbyaddr 84 +#define KEY_gethostbyname 85 +#define KEY_gethostent 86 +#define KEY_getlogin 87 +#define KEY_getnetbyaddr 88 +#define KEY_getnetbyname 89 +#define KEY_getnetent 90 +#define KEY_getpeername 91 +#define KEY_getpgrp 92 +#define KEY_getppid 93 +#define KEY_getpriority 94 +#define KEY_getprotobyname 95 +#define KEY_getprotobynumber 96 +#define KEY_getprotoent 97 +#define KEY_getpwent 98 +#define KEY_getpwnam 99 +#define KEY_getpwuid 100 +#define KEY_getservbyname 101 +#define KEY_getservbyport 102 +#define KEY_getservent 103 +#define KEY_getsockname 104 +#define KEY_getsockopt 105 +#define KEY_given 106 +#define KEY_glob 107 +#define KEY_gmtime 108 +#define KEY_goto 109 +#define KEY_grep 110 +#define KEY_gt 111 +#define KEY_hex 112 +#define KEY_if 113 +#define KEY_index 114 +#define KEY_int 115 +#define KEY_ioctl 116 +#define KEY_isa 117 +#define KEY_join 118 +#define KEY_keys 119 +#define KEY_kill 120 +#define KEY_last 121 +#define KEY_lc 122 +#define KEY_lcfirst 123 +#define KEY_le 124 +#define KEY_length 125 +#define KEY_link 126 +#define KEY_listen 127 +#define KEY_local 128 +#define KEY_localtime 129 +#define KEY_lock 130 +#define KEY_log 131 +#define KEY_lstat 132 +#define KEY_lt 133 +#define KEY_m 134 +#define KEY_map 135 +#define KEY_method 136 +#define KEY_mkdir 137 +#define KEY_msgctl 138 +#define KEY_msgget 139 +#define KEY_msgrcv 140 +#define KEY_msgsnd 141 +#define KEY_my 142 +#define KEY_ne 143 +#define KEY_next 144 +#define KEY_no 145 +#define KEY_not 146 +#define KEY_oct 147 +#define KEY_open 148 +#define KEY_opendir 149 +#define KEY_or 150 +#define KEY_ord 151 +#define KEY_our 152 +#define KEY_pack 153 +#define KEY_package 154 +#define KEY_pipe 155 +#define KEY_pop 156 +#define KEY_pos 157 +#define KEY_print 158 +#define KEY_printf 159 +#define KEY_prototype 160 +#define KEY_push 161 +#define KEY_q 162 +#define KEY_qq 163 +#define KEY_qr 164 +#define KEY_quotemeta 165 +#define KEY_qw 166 +#define KEY_qx 167 +#define KEY_rand 168 +#define KEY_read 169 +#define KEY_readdir 170 +#define KEY_readline 171 +#define KEY_readlink 172 +#define KEY_readpipe 173 +#define KEY_recv 174 +#define KEY_redo 175 +#define KEY_ref 176 +#define KEY_rename 177 +#define KEY_require 178 +#define KEY_reset 179 +#define KEY_return 180 +#define KEY_reverse 181 +#define KEY_rewinddir 182 +#define KEY_rindex 183 +#define KEY_rmdir 184 +#define KEY_s 185 +#define KEY_say 186 +#define KEY_scalar 187 +#define KEY_seek 188 +#define KEY_seekdir 189 +#define KEY_select 190 +#define KEY_semctl 191 +#define KEY_semget 192 +#define KEY_semop 193 +#define KEY_send 194 +#define KEY_setgrent 195 +#define KEY_sethostent 196 +#define KEY_setnetent 197 +#define KEY_setpgrp 198 +#define KEY_setpriority 199 +#define KEY_setprotoent 200 +#define KEY_setpwent 201 +#define KEY_setservent 202 +#define KEY_setsockopt 203 +#define KEY_shift 204 +#define KEY_shmctl 205 +#define KEY_shmget 206 +#define KEY_shmread 207 +#define KEY_shmwrite 208 +#define KEY_shutdown 209 +#define KEY_sin 210 +#define KEY_sleep 211 +#define KEY_socket 212 +#define KEY_socketpair 213 +#define KEY_sort 214 +#define KEY_splice 215 +#define KEY_split 216 +#define KEY_sprintf 217 +#define KEY_sqrt 218 +#define KEY_srand 219 +#define KEY_stat 220 +#define KEY_state 221 +#define KEY_study 222 +#define KEY_sub 223 +#define KEY_substr 224 +#define KEY_symlink 225 +#define KEY_syscall 226 +#define KEY_sysopen 227 +#define KEY_sysread 228 +#define KEY_sysseek 229 +#define KEY_system 230 +#define KEY_syswrite 231 +#define KEY_tell 232 +#define KEY_telldir 233 +#define KEY_tie 234 +#define KEY_tied 235 +#define KEY_time 236 +#define KEY_times 237 +#define KEY_tr 238 +#define KEY_try 239 +#define KEY_truncate 240 +#define KEY_uc 241 +#define KEY_ucfirst 242 +#define KEY_umask 243 +#define KEY_undef 244 +#define KEY_unless 245 +#define KEY_unlink 246 +#define KEY_unpack 247 +#define KEY_unshift 248 +#define KEY_untie 249 +#define KEY_until 250 +#define KEY_use 251 +#define KEY_utime 252 +#define KEY_values 253 +#define KEY_vec 254 +#define KEY_wait 255 +#define KEY_waitpid 256 +#define KEY_wantarray 257 +#define KEY_warn 258 +#define KEY_when 259 +#define KEY_while 260 +#define KEY_write 261 +#define KEY_x 262 +#define KEY_xor 263 +#define KEY_y 264 /* Generated from: - * eb67e851da14ede1aad67aec4a387fa250c1345407fad0a02988d2d8d3cc27f2 regen/keywords.pl - * ex: set ro: */ + * c8b75109fa56ce3ea3f30503a3b398f02e49036dc60d5fb36ea5ba9ffd6c596e regen/keywords.pl + * ex: set ro ft=c: */ diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t index ed9480ab0e29..b46c6b1d344d 100644 --- a/lib/B/Deparse-core.t +++ b/lib/B/Deparse-core.t @@ -352,6 +352,7 @@ my %not_tested = map { $_ => 1} qw( __FILE__ __LINE__ __PACKAGE__ + __CLASS__ ADJUST AUTOLOAD BEGIN diff --git a/op.c b/op.c index 280092993d1a..aa148f661ffc 100644 --- a/op.c +++ b/op.c @@ -14333,6 +14333,8 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) op_free(entersubop); switch(cvflags >> 16) { + case 'C': /* __CLASS__ */ + return newOP(OP_CLASSNAME, 0); case 'F': /* __FILE__ */ return newSVOP(OP_CONST, 0, newSVpv(CopFILE(PL_curcop),0)); @@ -15252,6 +15254,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, case KEY_values: retsetpvs("\\[%@]", OP_VALUES); case KEY_each: retsetpvs("\\[%@]", OP_EACH); case KEY_pos: retsetpvs(";\\[$*]", OP_POS); + case KEY___CLASS__: case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__: retsetpvs("", 0); case KEY_evalbytes: diff --git a/opcode.h b/opcode.h index 9f5182219a45..d944a55879c7 100644 --- a/opcode.h +++ b/opcode.h @@ -567,6 +567,7 @@ EXTCONST char* const PL_op_name[] INIT({ "helemexistsor", "methstart", "initfield", + "classname", "freed", }); @@ -992,6 +993,7 @@ EXTCONST char* const PL_op_desc[] INIT({ "hash element exists or", "method start", "initialise field", + "class name", "freed op", }); @@ -1422,6 +1424,7 @@ INIT({ Perl_pp_helemexistsor, Perl_pp_methstart, Perl_pp_initfield, + Perl_pp_classname, }); EXT Perl_check_t PL_check[] /* or perlvars.h */ @@ -1847,6 +1850,7 @@ INIT({ Perl_ck_helemexistsor, /* helemexistsor */ Perl_ck_null, /* methstart */ Perl_ck_null, /* initfield */ + Perl_ck_classname, /* classname */ }); EXTCONST U32 PL_opargs[] INIT({ @@ -2271,6 +2275,7 @@ EXTCONST U32 PL_opargs[] INIT({ 0x00011300, /* helemexistsor */ 0x00000f00, /* methstart */ 0x00000f00, /* initfield */ + 0x00000000, /* classname */ }); END_EXTERN_C @@ -2975,6 +2980,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 254, /* helemexistsor */ 256, /* methstart */ 258, /* initfield */ + -1, /* classname */ }; @@ -3501,6 +3507,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* HELEMEXISTSOR */ (OPpARG1_MASK|OPpHELEMEXISTSOR_DELETE), /* METHSTART */ (OPpARG1_MASK|OPpINITFIELDS), /* INITFIELD */ (OPpARG1_MASK|OPpINITFIELD_AV|OPpINITFIELD_HV), + /* CLASSNAME */ (0), }; diff --git a/opnames.h b/opnames.h index 71601b8f41f3..81e460f528ec 100644 --- a/opnames.h +++ b/opnames.h @@ -435,10 +435,11 @@ typedef enum opcode { OP_HELEMEXISTSOR = 418, OP_METHSTART = 419, OP_INITFIELD = 420, + OP_CLASSNAME = 421, OP_max } opcode; -#define MAXO 421 +#define MAXO 422 #define OP_FREED MAXO /* the OP_IS_* macros are optimized to a simple range check because diff --git a/pod/perlclass.pod b/pod/perlclass.pod index d4109e96d937..4c158d9c38e4 100644 --- a/pod/perlclass.pod +++ b/pod/perlclass.pod @@ -120,6 +120,27 @@ constructor at all. Expressions using C will also apply if the caller did pass the parameter but the value was undefined, and expressions using C<||=> will apply if the value was false. +During a field initializing expression, the instance is not yet constructed +and so the C<$self> lexical is not available. However, the special +C<__CLASS__> token may be used to obtain the name of the class being +constructed, for example in order to invoke class methods on it to help in +constructing values for fields. + + class WithCustomField { + use constant DEFAULT_X => 10; + field $x = __CLASS__->DEFAULT_X; + } + +This allows subclasses to override the method with different behaviour. + + class DifferentCustomField :isa(WithCustomField) { + sub DEFAULT_X { rand > 0.5 ? 20 : 30 } + } + +When an instance of C is constructed, the C<__CLASS__> +expression in the base will yield the correct class name, and so invoke this +overridden method instead. + =head2 method method METHOD_NAME SIGNATURE BLOCK diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 36a79d10d0b5..41771d13c3c3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -788,6 +788,13 @@ keep a reference count on its arguments and cannot be made to do so. Such arrays are not even supposed to be accessible to Perl code, but are only used internally. +=item Cannot use __CLASS__ outside of a method or field initializer expression + +(F) A C<__CLASS__> expression yields the class name of the object instance +executing the current method, and therefore it can only be placed inside an +actual method (or method-like expression, such as a field initializer +expression). + =item Cannot yet reorder sv_vcatpvfn() arguments from va_list (F) Some XS code tried to use C or a related function with a diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index af54e82d7ddd..74968c16ec7c 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -352,6 +352,7 @@ X X X L|/bless REF,CLASSNAME>, L|/class NAMESPACE>, +L|/__CLASS__>, L|/dbmclose HASH>, L|/dbmopen HASH,DBNAME,MASK>, L|/field VARNAME>, @@ -6059,6 +6060,37 @@ X<__PACKAGE__> A special token that returns the name of the package in which it occurs. +=item __CLASS__ +X<__CLASS__> + +=for Pod::Functions the class name of the current instance. + +Invoked within a C or similar location, such as a field initializer +expression, this token returns the name of the class of the invoking instance. +Essentially it is equivalent to C except that it can additionally +be used in a field initializer to gain access to class methods, before the +instance is fully constructed. + + use feature 'class'; + + class Example1 { + field $f = __CLASS__->default_f; + + sub default_f { 10 } + } + +In a basic class, this value will be the same as C<__PACKAGE__>. The +distinction can be seen when a subclass is constructed; it will give the class +name of the instance being constructed, rather than just the package name that +the actual code belongs to. + + class Example2 :isa(Example1) { + sub default_f { 20 } + } + + my $obj = Example2->new; + # The $f field now has the value 20 + =item pipe READHANDLE,WRITEHANDLE X diff --git a/pp_proto.h b/pp_proto.h index a3a8f4551861..cbb598db6e71 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -43,6 +43,7 @@ PERL_CALLCONV PP(pp_chop) __attribute__visibility__("hidden"); PERL_CALLCONV PP(pp_chown) __attribute__visibility__("hidden"); PERL_CALLCONV PP(pp_chr) __attribute__visibility__("hidden"); PERL_CALLCONV PP(pp_chroot) __attribute__visibility__("hidden"); +PERL_CALLCONV PP(pp_classname) __attribute__visibility__("hidden"); PERL_CALLCONV PP(pp_clonecv) __attribute__visibility__("hidden"); PERL_CALLCONV PP(pp_close) __attribute__visibility__("hidden"); PERL_CALLCONV PP(pp_closedir) __attribute__visibility__("hidden"); diff --git a/proto.h b/proto.h index ee23dd2ba73b..ddb77746d525 100644 --- a/proto.h +++ b/proto.h @@ -6172,615 +6172,622 @@ S_get_aux_mg(pTHX_ AV *av); assert(av) #endif -#if defined(PERL_IN_CLASS_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_PAD_C) || defined(PERL_IN_PERLY_C) || \ - defined(PERL_IN_TOKE_C) -PERL_CALLCONV void -Perl_class_add_ADJUST(pTHX_ HV *stash, CV *cv); -# define PERL_ARGS_ASSERT_CLASS_ADD_ADJUST \ - assert(stash); assert(cv) - -PERL_CALLCONV void -Perl_class_add_field(pTHX_ HV *stash, PADNAME *pn); -# define PERL_ARGS_ASSERT_CLASS_ADD_FIELD \ - assert(stash); assert(pn) - -PERL_CALLCONV void -Perl_class_apply_attributes(pTHX_ HV *stash, OP *attrlist); -# define PERL_ARGS_ASSERT_CLASS_APPLY_ATTRIBUTES \ - assert(stash) - -PERL_CALLCONV void -Perl_class_apply_field_attributes(pTHX_ PADNAME *pn, OP *attrlist); -# define PERL_ARGS_ASSERT_CLASS_APPLY_FIELD_ATTRIBUTES \ - assert(pn) - -PERL_CALLCONV void -Perl_class_prepare_initfield_parse(pTHX); -# define PERL_ARGS_ASSERT_CLASS_PREPARE_INITFIELD_PARSE - -PERL_CALLCONV void -Perl_class_prepare_method_parse(pTHX_ CV *cv); -# define PERL_ARGS_ASSERT_CLASS_PREPARE_METHOD_PARSE \ - assert(cv) - -PERL_CALLCONV void -Perl_class_seal_stash(pTHX_ HV *stash); -# define PERL_ARGS_ASSERT_CLASS_SEAL_STASH \ - assert(stash) - -PERL_CALLCONV void -Perl_class_set_field_defop(pTHX_ PADNAME *pn, OPCODE defmode, OP *defop); -# define PERL_ARGS_ASSERT_CLASS_SET_FIELD_DEFOP \ - assert(pn); assert(defop) - -PERL_CALLCONV void -Perl_class_setup_stash(pTHX_ HV *stash); -# define PERL_ARGS_ASSERT_CLASS_SETUP_STASH \ - assert(stash) - +#if defined(PERL_IN_CLASS_C) || defined(PERL_IN_GLOBALS_C) || \ + defined(PERL_IN_OP_C) || defined(PERL_IN_PEEP_C) PERL_CALLCONV OP * -Perl_class_wrap_method_body(pTHX_ OP *o); -# define PERL_ARGS_ASSERT_CLASS_WRAP_METHOD_BODY - -PERL_CALLCONV void -Perl_croak_kw_unless_class(pTHX_ const char *kw); -# define PERL_ARGS_ASSERT_CROAK_KW_UNLESS_CLASS \ - assert(kw) - -#endif /* defined(PERL_IN_CLASS_C) || defined(PERL_IN_OP_C) || - defined(PERL_IN_PAD_C) || defined(PERL_IN_PERLY_C) || - defined(PERL_IN_TOKE_C) */ -#if defined(PERL_IN_DEB_C) -STATIC void -S_deb_stack_n(pTHX_ SV **stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max); -# define PERL_ARGS_ASSERT_DEB_STACK_N \ - assert(stack_base) - -#endif -#if defined(PERL_IN_DOIO_C) -STATIC bool -S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool is_explicit); -# define PERL_ARGS_ASSERT_ARGVOUT_FINAL \ - assert(mg); assert(io) - -STATIC void -S_exec_failed(pTHX_ const char *cmd, int fd, int do_report); -# define PERL_ARGS_ASSERT_EXEC_FAILED \ - assert(cmd) - -STATIC bool -S_ingroup(pTHX_ Gid_t testgid, bool effective) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_INGROUP - -STATIC bool -S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, int writing, bool was_fdopen, const char *type, Stat_t *statbufp); -# define PERL_ARGS_ASSERT_OPENN_CLEANUP \ - assert(gv); assert(io); assert(mode); assert(oname) - -STATIC IO * -S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp, int *savefd, char *savetype); -# define PERL_ARGS_ASSERT_OPENN_SETUP \ - assert(gv); assert(mode); assert(saveifp); assert(saveofp); assert(savefd); \ - assert(savetype) - -#endif /* defined(PERL_IN_DOIO_C) */ -#if defined(PERL_IN_DOOP_C) -STATIC Size_t -S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_DO_TRANS_COMPLEX \ - assert(sv); assert(tbl) - -STATIC Size_t -S_do_trans_count(pTHX_ SV * const sv, const OPtrans_map * const tbl) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_DO_TRANS_COUNT \ - assert(sv); assert(tbl) - -STATIC Size_t -S_do_trans_count_invmap(pTHX_ SV * const sv, AV * const map) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_DO_TRANS_COUNT_INVMAP \ - assert(sv); assert(map) - -STATIC Size_t -S_do_trans_invmap(pTHX_ SV * const sv, AV * const map) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_DO_TRANS_INVMAP \ - assert(sv); assert(map) - -STATIC Size_t -S_do_trans_simple(pTHX_ SV * const sv, const OPtrans_map * const tbl) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_DO_TRANS_SIMPLE \ - assert(sv); assert(tbl) +Perl_ck_anoncode(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_ANONCODE \ + assert(o) -#endif /* defined(PERL_IN_DOOP_C) */ -#if defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_PP_C) || defined(PERL_IN_REGCOMP_ANY) || \ - defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || \ - defined(PERL_IN_UTF8_C) +PERL_CALLCONV OP * +Perl_ck_backtick(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_BACKTICK \ + assert(o) -PERL_CALLCONV SSize_t -Perl__invlist_search(SV * const invlist, const UV cp) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT__INVLIST_SEARCH \ - assert(invlist) +PERL_CALLCONV OP * +Perl_ck_bitop(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_BITOP \ + assert(o) -#endif /* defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || - defined(PERL_IN_PP_C) || defined(PERL_IN_REGCOMP_ANY) || - defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || - defined(PERL_IN_UTF8_C) */ -#if defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_REGCOMP_ANY) +PERL_CALLCONV OP * +Perl_ck_classname(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_CLASSNAME \ + assert(o) -#endif -#if defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_UTF8_C) -PERL_CALLCONV SV * -Perl__add_range_to_invlist(pTHX_ SV *invlist, UV start, UV end) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT__ADD_RANGE_TO_INVLIST +PERL_CALLCONV OP * +Perl_ck_cmp(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_CMP \ + assert(o) -/* PERL_CALLCONV void -_invlist_intersection(pTHX_ SV * const a, SV * const b, SV **i); */ +PERL_CALLCONV OP * +Perl_ck_concat(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_CONCAT \ + assert(o) -PERL_CALLCONV void -Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV * const a, SV * const b, const bool complement_b, SV **i); -# define PERL_ARGS_ASSERT__INVLIST_INTERSECTION_MAYBE_COMPLEMENT_2ND \ - assert(b); assert(i) +PERL_CALLCONV OP * +Perl_ck_defined(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_DEFINED \ + assert(o) -PERL_CALLCONV void -Perl__invlist_invert(pTHX_ SV * const invlist); -# define PERL_ARGS_ASSERT__INVLIST_INVERT \ - assert(invlist) +PERL_CALLCONV OP * +Perl_ck_delete(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_DELETE \ + assert(o) -/* PERL_CALLCONV void -_invlist_subtract(pTHX_ SV * const a, SV * const b, SV **result); */ +PERL_CALLCONV OP * +Perl_ck_each(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_EACH \ + assert(o) -/* PERL_CALLCONV void -_invlist_union(pTHX_ SV * const a, SV * const b, SV **output); */ +PERL_CALLCONV OP * +Perl_ck_eof(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_EOF \ + assert(o) -PERL_CALLCONV void -Perl__invlist_union_maybe_complement_2nd(pTHX_ SV * const a, SV * const b, const bool complement_b, SV **output); -# define PERL_ARGS_ASSERT__INVLIST_UNION_MAYBE_COMPLEMENT_2ND \ - assert(b); assert(output) +PERL_CALLCONV OP * +Perl_ck_eval(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_EVAL \ + assert(o) -PERL_CALLCONV SV * -Perl__new_invlist(pTHX_ IV initial_size) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT__NEW_INVLIST +PERL_CALLCONV OP * +Perl_ck_exec(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_EXEC \ + assert(o) -PERL_CALLCONV SV * -Perl__setup_canned_invlist(pTHX_ const STRLEN size, const UV element0, UV **other_elements_ptr) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT__SETUP_CANNED_INVLIST \ - assert(other_elements_ptr) +PERL_CALLCONV OP * +Perl_ck_exists(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_EXISTS \ + assert(o) -#endif /* defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || - defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_UTF8_C) */ -#if defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_REGCOMP_C) || \ - defined(PERL_IN_TOKE_C) -PERL_CALLCONV const char * -Perl_form_alien_digit_msg(pTHX_ const U8 which, const STRLEN valids_len, const char * const first_bad, const char * const send, const bool UTF, const bool braced) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_FORM_ALIEN_DIGIT_MSG \ - assert(first_bad); assert(send) +PERL_CALLCONV OP * +Perl_ck_ftst(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_FTST \ + assert(o) -PERL_CALLCONV bool -Perl_grok_bslash_c(pTHX_ const char source, U8 *result, const char **message, U32 *packed_warn) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_GROK_BSLASH_C \ - assert(result); assert(message) +PERL_CALLCONV OP * +Perl_ck_fun(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_FUN \ + assert(o) -PERL_CALLCONV bool -Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, const char **message, U32 *packed_warn, const bool strict, const bool allow_UV_MAX, const bool utf8) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_GROK_BSLASH_O \ - assert(s); assert(send); assert(uv); assert(message) +PERL_CALLCONV OP * +Perl_ck_glob(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_GLOB \ + assert(o) -PERL_CALLCONV bool -Perl_grok_bslash_x(pTHX_ char **s, const char * const send, UV *uv, const char **message, U32 *packed_warn, const bool strict, const bool allow_UV_MAX, const bool utf8) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_GROK_BSLASH_X \ - assert(s); assert(send); assert(uv); assert(message) +PERL_CALLCONV OP * +Perl_ck_grep(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_GREP \ + assert(o) -#endif /* defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_REGCOMP_C) || - defined(PERL_IN_TOKE_C) */ -#if defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_REGCOMP_C) || \ - defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) -PERL_CALLCONV const char * -Perl_form_cp_too_large_msg(pTHX_ const U8 which, const char *string, const Size_t len, const UV cp) - __attribute__warn_unused_result__; -# define PERL_ARGS_ASSERT_FORM_CP_TOO_LARGE_MSG +PERL_CALLCONV OP * +Perl_ck_helemexistsor(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_HELEMEXISTSOR \ + assert(o) -#endif -#if defined(PERL_IN_DUMP_C) -STATIC CV * -S_deb_curcv(pTHX_ I32 ix); -# define PERL_ARGS_ASSERT_DEB_CURCV +PERL_CALLCONV OP * +Perl_ck_index(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_INDEX \ + assert(o) -STATIC void -S_debprof(pTHX_ const OP *o); -# define PERL_ARGS_ASSERT_DEBPROF \ +PERL_CALLCONV OP * +Perl_ck_isa(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_ISA \ assert(o) -STATIC SV * -S_pm_description(pTHX_ const PMOP *pm); -# define PERL_ARGS_ASSERT_PM_DESCRIPTION \ - assert(pm) +PERL_CALLCONV OP * +Perl_ck_join(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_JOIN \ + assert(o) -STATIC UV -S_sequence_num(pTHX_ const OP *o); -# define PERL_ARGS_ASSERT_SEQUENCE_NUM +PERL_CALLCONV OP * +Perl_ck_length(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_LENGTH \ + assert(o) -#endif /* defined(PERL_IN_DUMP_C) */ -#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || \ - defined(PERL_IN_SCOPE_C) || defined(PERL_IN_SV_C) -PERL_CALLCONV void -Perl_hv_kill_backrefs(pTHX_ HV *hv) +PERL_CALLCONV OP * +Perl_ck_lfun(pTHX_ OP *o) + __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_HV_KILL_BACKREFS \ - assert(hv) +# define PERL_ARGS_ASSERT_CK_LFUN \ + assert(o) -#endif -#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_REGCOMP_ANY) -PERL_CALLCONV void -Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, const char * const indent, SV * const invlist); -# define PERL_ARGS_ASSERT__INVLIST_DUMP \ - assert(file); assert(indent); assert(invlist) +PERL_CALLCONV OP * +Perl_ck_listiob(pTHX_ OP *o) + __attribute__warn_unused_result__ + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_CK_LISTIOB \ + assert(o) -#endif -#if defined(PERL_IN_GLOBALS_C) || defined(PERL_IN_OP_C) || \ - defined(PERL_IN_PEEP_C) PERL_CALLCONV OP * -Perl_ck_anoncode(pTHX_ OP *o) +Perl_ck_match(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_ANONCODE \ +# define PERL_ARGS_ASSERT_CK_MATCH \ assert(o) PERL_CALLCONV OP * -Perl_ck_backtick(pTHX_ OP *o) +Perl_ck_method(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_BACKTICK \ +# define PERL_ARGS_ASSERT_CK_METHOD \ assert(o) PERL_CALLCONV OP * -Perl_ck_bitop(pTHX_ OP *o) +Perl_ck_null(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_BITOP \ +# define PERL_ARGS_ASSERT_CK_NULL \ assert(o) PERL_CALLCONV OP * -Perl_ck_cmp(pTHX_ OP *o) +Perl_ck_open(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_CMP \ +# define PERL_ARGS_ASSERT_CK_OPEN \ assert(o) PERL_CALLCONV OP * -Perl_ck_concat(pTHX_ OP *o) +Perl_ck_prototype(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_CONCAT \ +# define PERL_ARGS_ASSERT_CK_PROTOTYPE \ assert(o) PERL_CALLCONV OP * -Perl_ck_defined(pTHX_ OP *o) +Perl_ck_readline(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_DEFINED \ +# define PERL_ARGS_ASSERT_CK_READLINE \ assert(o) PERL_CALLCONV OP * -Perl_ck_delete(pTHX_ OP *o) +Perl_ck_refassign(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_DELETE \ +# define PERL_ARGS_ASSERT_CK_REFASSIGN \ assert(o) PERL_CALLCONV OP * -Perl_ck_each(pTHX_ OP *o) +Perl_ck_repeat(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_EACH \ +# define PERL_ARGS_ASSERT_CK_REPEAT \ assert(o) PERL_CALLCONV OP * -Perl_ck_eof(pTHX_ OP *o) +Perl_ck_require(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_EOF \ +# define PERL_ARGS_ASSERT_CK_REQUIRE \ assert(o) PERL_CALLCONV OP * -Perl_ck_eval(pTHX_ OP *o) +Perl_ck_return(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_EVAL \ +# define PERL_ARGS_ASSERT_CK_RETURN \ assert(o) PERL_CALLCONV OP * -Perl_ck_exec(pTHX_ OP *o) +Perl_ck_rfun(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_EXEC \ +# define PERL_ARGS_ASSERT_CK_RFUN \ assert(o) PERL_CALLCONV OP * -Perl_ck_exists(pTHX_ OP *o) +Perl_ck_rvconst(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_EXISTS \ +# define PERL_ARGS_ASSERT_CK_RVCONST \ assert(o) PERL_CALLCONV OP * -Perl_ck_ftst(pTHX_ OP *o) +Perl_ck_sassign(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_FTST \ +# define PERL_ARGS_ASSERT_CK_SASSIGN \ assert(o) PERL_CALLCONV OP * -Perl_ck_fun(pTHX_ OP *o) +Perl_ck_select(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_FUN \ +# define PERL_ARGS_ASSERT_CK_SELECT \ assert(o) PERL_CALLCONV OP * -Perl_ck_glob(pTHX_ OP *o) +Perl_ck_shift(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_GLOB \ +# define PERL_ARGS_ASSERT_CK_SHIFT \ assert(o) PERL_CALLCONV OP * -Perl_ck_grep(pTHX_ OP *o) +Perl_ck_smartmatch(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_GREP \ +# define PERL_ARGS_ASSERT_CK_SMARTMATCH \ assert(o) PERL_CALLCONV OP * -Perl_ck_helemexistsor(pTHX_ OP *o) +Perl_ck_sort(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_HELEMEXISTSOR \ +# define PERL_ARGS_ASSERT_CK_SORT \ assert(o) PERL_CALLCONV OP * -Perl_ck_index(pTHX_ OP *o) +Perl_ck_spair(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_INDEX \ +# define PERL_ARGS_ASSERT_CK_SPAIR \ assert(o) PERL_CALLCONV OP * -Perl_ck_isa(pTHX_ OP *o) +Perl_ck_split(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_ISA \ +# define PERL_ARGS_ASSERT_CK_SPLIT \ assert(o) PERL_CALLCONV OP * -Perl_ck_join(pTHX_ OP *o) +Perl_ck_stringify(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_JOIN \ +# define PERL_ARGS_ASSERT_CK_STRINGIFY \ assert(o) PERL_CALLCONV OP * -Perl_ck_length(pTHX_ OP *o) +Perl_ck_subr(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_LENGTH \ +# define PERL_ARGS_ASSERT_CK_SUBR \ assert(o) PERL_CALLCONV OP * -Perl_ck_lfun(pTHX_ OP *o) +Perl_ck_substr(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_LFUN \ +# define PERL_ARGS_ASSERT_CK_SUBSTR \ assert(o) PERL_CALLCONV OP * -Perl_ck_listiob(pTHX_ OP *o) +Perl_ck_svconst(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_LISTIOB \ +# define PERL_ARGS_ASSERT_CK_SVCONST \ assert(o) PERL_CALLCONV OP * -Perl_ck_match(pTHX_ OP *o) +Perl_ck_tell(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_MATCH \ +# define PERL_ARGS_ASSERT_CK_TELL \ assert(o) PERL_CALLCONV OP * -Perl_ck_method(pTHX_ OP *o) +Perl_ck_trunc(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_METHOD \ +# define PERL_ARGS_ASSERT_CK_TRUNC \ assert(o) PERL_CALLCONV OP * -Perl_ck_null(pTHX_ OP *o) +Perl_ck_trycatch(pTHX_ OP *o) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_NULL \ +# define PERL_ARGS_ASSERT_CK_TRYCATCH \ assert(o) -PERL_CALLCONV OP * -Perl_ck_open(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_OPEN \ - assert(o) +#endif /* defined(PERL_IN_CLASS_C) || defined(PERL_IN_GLOBALS_C) || + defined(PERL_IN_OP_C) || defined(PERL_IN_PEEP_C) */ +#if defined(PERL_IN_CLASS_C) || defined(PERL_IN_OP_C) || \ + defined(PERL_IN_PAD_C) || defined(PERL_IN_PERLY_C) || \ + defined(PERL_IN_TOKE_C) +PERL_CALLCONV void +Perl_class_add_ADJUST(pTHX_ HV *stash, CV *cv); +# define PERL_ARGS_ASSERT_CLASS_ADD_ADJUST \ + assert(stash); assert(cv) + +PERL_CALLCONV void +Perl_class_add_field(pTHX_ HV *stash, PADNAME *pn); +# define PERL_ARGS_ASSERT_CLASS_ADD_FIELD \ + assert(stash); assert(pn) + +PERL_CALLCONV void +Perl_class_apply_attributes(pTHX_ HV *stash, OP *attrlist); +# define PERL_ARGS_ASSERT_CLASS_APPLY_ATTRIBUTES \ + assert(stash) + +PERL_CALLCONV void +Perl_class_apply_field_attributes(pTHX_ PADNAME *pn, OP *attrlist); +# define PERL_ARGS_ASSERT_CLASS_APPLY_FIELD_ATTRIBUTES \ + assert(pn) + +PERL_CALLCONV void +Perl_class_prepare_initfield_parse(pTHX); +# define PERL_ARGS_ASSERT_CLASS_PREPARE_INITFIELD_PARSE + +PERL_CALLCONV void +Perl_class_prepare_method_parse(pTHX_ CV *cv); +# define PERL_ARGS_ASSERT_CLASS_PREPARE_METHOD_PARSE \ + assert(cv) + +PERL_CALLCONV void +Perl_class_seal_stash(pTHX_ HV *stash); +# define PERL_ARGS_ASSERT_CLASS_SEAL_STASH \ + assert(stash) + +PERL_CALLCONV void +Perl_class_set_field_defop(pTHX_ PADNAME *pn, OPCODE defmode, OP *defop); +# define PERL_ARGS_ASSERT_CLASS_SET_FIELD_DEFOP \ + assert(pn); assert(defop) + +PERL_CALLCONV void +Perl_class_setup_stash(pTHX_ HV *stash); +# define PERL_ARGS_ASSERT_CLASS_SETUP_STASH \ + assert(stash) + +PERL_CALLCONV OP * +Perl_class_wrap_method_body(pTHX_ OP *o); +# define PERL_ARGS_ASSERT_CLASS_WRAP_METHOD_BODY + +PERL_CALLCONV void +Perl_croak_kw_unless_class(pTHX_ const char *kw); +# define PERL_ARGS_ASSERT_CROAK_KW_UNLESS_CLASS \ + assert(kw) + +#endif /* defined(PERL_IN_CLASS_C) || defined(PERL_IN_OP_C) || + defined(PERL_IN_PAD_C) || defined(PERL_IN_PERLY_C) || + defined(PERL_IN_TOKE_C) */ +#if defined(PERL_IN_DEB_C) +STATIC void +S_deb_stack_n(pTHX_ SV **stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max); +# define PERL_ARGS_ASSERT_DEB_STACK_N \ + assert(stack_base) + +#endif +#if defined(PERL_IN_DOIO_C) +STATIC bool +S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool is_explicit); +# define PERL_ARGS_ASSERT_ARGVOUT_FINAL \ + assert(mg); assert(io) + +STATIC void +S_exec_failed(pTHX_ const char *cmd, int fd, int do_report); +# define PERL_ARGS_ASSERT_EXEC_FAILED \ + assert(cmd) + +STATIC bool +S_ingroup(pTHX_ Gid_t testgid, bool effective) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_INGROUP + +STATIC bool +S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype, int writing, bool was_fdopen, const char *type, Stat_t *statbufp); +# define PERL_ARGS_ASSERT_OPENN_CLEANUP \ + assert(gv); assert(io); assert(mode); assert(oname) + +STATIC IO * +S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp, int *savefd, char *savetype); +# define PERL_ARGS_ASSERT_OPENN_SETUP \ + assert(gv); assert(mode); assert(saveifp); assert(saveofp); assert(savefd); \ + assert(savetype) + +#endif /* defined(PERL_IN_DOIO_C) */ +#if defined(PERL_IN_DOOP_C) +STATIC Size_t +S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_DO_TRANS_COMPLEX \ + assert(sv); assert(tbl) + +STATIC Size_t +S_do_trans_count(pTHX_ SV * const sv, const OPtrans_map * const tbl) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_DO_TRANS_COUNT \ + assert(sv); assert(tbl) + +STATIC Size_t +S_do_trans_count_invmap(pTHX_ SV * const sv, AV * const map) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_DO_TRANS_COUNT_INVMAP \ + assert(sv); assert(map) + +STATIC Size_t +S_do_trans_invmap(pTHX_ SV * const sv, AV * const map) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_DO_TRANS_INVMAP \ + assert(sv); assert(map) + +STATIC Size_t +S_do_trans_simple(pTHX_ SV * const sv, const OPtrans_map * const tbl) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_DO_TRANS_SIMPLE \ + assert(sv); assert(tbl) -PERL_CALLCONV OP * -Perl_ck_prototype(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_PROTOTYPE \ - assert(o) +#endif /* defined(PERL_IN_DOOP_C) */ +#if defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || \ + defined(PERL_IN_PP_C) || defined(PERL_IN_REGCOMP_ANY) || \ + defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || \ + defined(PERL_IN_UTF8_C) -PERL_CALLCONV OP * -Perl_ck_readline(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_READLINE \ - assert(o) +PERL_CALLCONV SSize_t +Perl__invlist_search(SV * const invlist, const UV cp) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT__INVLIST_SEARCH \ + assert(invlist) -PERL_CALLCONV OP * -Perl_ck_refassign(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_REFASSIGN \ - assert(o) +#endif /* defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || + defined(PERL_IN_PP_C) || defined(PERL_IN_REGCOMP_ANY) || + defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || + defined(PERL_IN_UTF8_C) */ +#if defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || \ + defined(PERL_IN_REGCOMP_ANY) -PERL_CALLCONV OP * -Perl_ck_repeat(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_REPEAT \ - assert(o) +#endif +#if defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || \ + defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_UTF8_C) +PERL_CALLCONV SV * +Perl__add_range_to_invlist(pTHX_ SV *invlist, UV start, UV end) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT__ADD_RANGE_TO_INVLIST -PERL_CALLCONV OP * -Perl_ck_require(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_REQUIRE \ - assert(o) +/* PERL_CALLCONV void +_invlist_intersection(pTHX_ SV * const a, SV * const b, SV **i); */ -PERL_CALLCONV OP * -Perl_ck_return(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_RETURN \ - assert(o) +PERL_CALLCONV void +Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV * const a, SV * const b, const bool complement_b, SV **i); +# define PERL_ARGS_ASSERT__INVLIST_INTERSECTION_MAYBE_COMPLEMENT_2ND \ + assert(b); assert(i) -PERL_CALLCONV OP * -Perl_ck_rfun(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_RFUN \ - assert(o) +PERL_CALLCONV void +Perl__invlist_invert(pTHX_ SV * const invlist); +# define PERL_ARGS_ASSERT__INVLIST_INVERT \ + assert(invlist) -PERL_CALLCONV OP * -Perl_ck_rvconst(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_RVCONST \ - assert(o) +/* PERL_CALLCONV void +_invlist_subtract(pTHX_ SV * const a, SV * const b, SV **result); */ -PERL_CALLCONV OP * -Perl_ck_sassign(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SASSIGN \ - assert(o) +/* PERL_CALLCONV void +_invlist_union(pTHX_ SV * const a, SV * const b, SV **output); */ -PERL_CALLCONV OP * -Perl_ck_select(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SELECT \ - assert(o) +PERL_CALLCONV void +Perl__invlist_union_maybe_complement_2nd(pTHX_ SV * const a, SV * const b, const bool complement_b, SV **output); +# define PERL_ARGS_ASSERT__INVLIST_UNION_MAYBE_COMPLEMENT_2ND \ + assert(b); assert(output) -PERL_CALLCONV OP * -Perl_ck_shift(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SHIFT \ - assert(o) +PERL_CALLCONV SV * +Perl__new_invlist(pTHX_ IV initial_size) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT__NEW_INVLIST -PERL_CALLCONV OP * -Perl_ck_smartmatch(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SMARTMATCH \ - assert(o) +PERL_CALLCONV SV * +Perl__setup_canned_invlist(pTHX_ const STRLEN size, const UV element0, UV **other_elements_ptr) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT__SETUP_CANNED_INVLIST \ + assert(other_elements_ptr) -PERL_CALLCONV OP * -Perl_ck_sort(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SORT \ - assert(o) +#endif /* defined(PERL_IN_DOOP_C) || defined(PERL_IN_OP_C) || + defined(PERL_IN_REGCOMP_ANY) || defined(PERL_IN_UTF8_C) */ +#if defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_REGCOMP_C) || \ + defined(PERL_IN_TOKE_C) +PERL_CALLCONV const char * +Perl_form_alien_digit_msg(pTHX_ const U8 which, const STRLEN valids_len, const char * const first_bad, const char * const send, const bool UTF, const bool braced) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_FORM_ALIEN_DIGIT_MSG \ + assert(first_bad); assert(send) -PERL_CALLCONV OP * -Perl_ck_spair(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SPAIR \ - assert(o) +PERL_CALLCONV bool +Perl_grok_bslash_c(pTHX_ const char source, U8 *result, const char **message, U32 *packed_warn) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_GROK_BSLASH_C \ + assert(result); assert(message) -PERL_CALLCONV OP * -Perl_ck_split(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SPLIT \ - assert(o) +PERL_CALLCONV bool +Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, const char **message, U32 *packed_warn, const bool strict, const bool allow_UV_MAX, const bool utf8) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_GROK_BSLASH_O \ + assert(s); assert(send); assert(uv); assert(message) -PERL_CALLCONV OP * -Perl_ck_stringify(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_STRINGIFY \ - assert(o) +PERL_CALLCONV bool +Perl_grok_bslash_x(pTHX_ char **s, const char * const send, UV *uv, const char **message, U32 *packed_warn, const bool strict, const bool allow_UV_MAX, const bool utf8) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_GROK_BSLASH_X \ + assert(s); assert(send); assert(uv); assert(message) -PERL_CALLCONV OP * -Perl_ck_subr(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SUBR \ - assert(o) +#endif /* defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_REGCOMP_C) || + defined(PERL_IN_TOKE_C) */ +#if defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_REGCOMP_C) || \ + defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) +PERL_CALLCONV const char * +Perl_form_cp_too_large_msg(pTHX_ const U8 which, const char *string, const Size_t len, const UV cp) + __attribute__warn_unused_result__; +# define PERL_ARGS_ASSERT_FORM_CP_TOO_LARGE_MSG -PERL_CALLCONV OP * -Perl_ck_substr(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SUBSTR \ - assert(o) +#endif +#if defined(PERL_IN_DUMP_C) +STATIC CV * +S_deb_curcv(pTHX_ I32 ix); +# define PERL_ARGS_ASSERT_DEB_CURCV -PERL_CALLCONV OP * -Perl_ck_svconst(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_SVCONST \ +STATIC void +S_debprof(pTHX_ const OP *o); +# define PERL_ARGS_ASSERT_DEBPROF \ assert(o) -PERL_CALLCONV OP * -Perl_ck_tell(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_TELL \ - assert(o) +STATIC SV * +S_pm_description(pTHX_ const PMOP *pm); +# define PERL_ARGS_ASSERT_PM_DESCRIPTION \ + assert(pm) -PERL_CALLCONV OP * -Perl_ck_trunc(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_TRUNC \ - assert(o) +STATIC UV +S_sequence_num(pTHX_ const OP *o); +# define PERL_ARGS_ASSERT_SEQUENCE_NUM -PERL_CALLCONV OP * -Perl_ck_trycatch(pTHX_ OP *o) - __attribute__warn_unused_result__ +#endif /* defined(PERL_IN_DUMP_C) */ +#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || \ + defined(PERL_IN_SCOPE_C) || defined(PERL_IN_SV_C) +PERL_CALLCONV void +Perl_hv_kill_backrefs(pTHX_ HV *hv) __attribute__visibility__("hidden"); -# define PERL_ARGS_ASSERT_CK_TRYCATCH \ - assert(o) +# define PERL_ARGS_ASSERT_HV_KILL_BACKREFS \ + assert(hv) + +#endif +#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_OP_C) || \ + defined(PERL_IN_REGCOMP_ANY) +PERL_CALLCONV void +Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, const char * const indent, SV * const invlist); +# define PERL_ARGS_ASSERT__INVLIST_DUMP \ + assert(file); assert(indent); assert(invlist) -#endif /* defined(PERL_IN_GLOBALS_C) || defined(PERL_IN_OP_C) || - defined(PERL_IN_PEEP_C) */ +#endif #if defined(PERL_IN_GV_C) STATIC bool S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, const U32 is_utf8, const I32 add, const svtype sv_type); diff --git a/regen/embed_lib.pl b/regen/embed_lib.pl index c826cdb60441..e5a6601bb424 100644 --- a/regen/embed_lib.pl +++ b/regen/embed_lib.pl @@ -55,7 +55,7 @@ sub setup_embed { # These are all indirectly referenced by globals.c. my $new= HeaderLine->new( - cond => [["defined(PERL_IN_GLOBALS_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_PEEP_C)"]], + cond => [["defined(PERL_IN_GLOBALS_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_PEEP_C) || defined(PERL_IN_CLASS_C)"]], raw => "pR|OP *|$check|NN OP *o", line => "pR|OP *|$check|NN OP *o", type => "content", diff --git a/regen/keywords.pl b/regen/keywords.pl index 2438436bf056..4854fda3778e 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -55,6 +55,7 @@ field => 'class', method => 'class', ADJUST => 'class', + __CLASS__ => 'class', ); my %pos = map { ($_ => 1) } @{$by_strength{'+'}}; @@ -120,6 +121,7 @@ END -__FILE__ -__LINE__ -__PACKAGE__ +-__CLASS__ +__DATA__ +__END__ -__SUB__ diff --git a/regen/opcodes b/regen/opcodes index 9bdf5c54801b..97a243bfbd36 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -603,3 +603,5 @@ helemexistsor hash element exists or ck_helemexistsor | S S methstart method start ck_null + initfield initialise field ck_null + + +classname class name ck_classname 0 diff --git a/t/class/class.t b/t/class/class.t index 4e24e49bf408..b5f7729d8191 100644 --- a/t/class/class.t +++ b/t/class/class.t @@ -14,12 +14,16 @@ no warnings 'experimental::class'; { class Test1 { method hello { return "hello, world"; } + + method classname { return __CLASS__; } } my $obj = Test1->new; isa_ok($obj, "Test1", '$obj'); is($obj->hello, "hello, world", '$obj->hello'); + + is($obj->classname, "Test1", '$obj->classname yields __CLASS__'); } # Classes are still regular packages diff --git a/t/class/inherit.t b/t/class/inherit.t index 9fd314b9f925..38a05f371bed 100644 --- a/t/class/inherit.t +++ b/t/class/inherit.t @@ -18,6 +18,8 @@ no warnings 'experimental::class'; field $adja; ADJUST { $adja = "base class" } method adja { return $adja; } + + method classname { return __CLASS__; } } class Test1B :isa(Test1A) { @@ -42,6 +44,8 @@ no warnings 'experimental::class'; can_ok($obj, "adja"); is($obj->adja, "base class", 'Object has base class ADJUSTed field'); + is($obj->classname, "Test1B", '__CLASS__ yields runtime instance class name'); + class Test1C :isa( Test1A ) { } my $objc = Test1C->new; diff --git a/t/lib/croak/class b/t/lib/croak/class index 446026723141..6b95ce11f6f9 100644 --- a/t/lib/croak/class +++ b/t/lib/croak/class @@ -128,3 +128,12 @@ class YYY :isa(XXX) { } EXPECT Cannot assign :param(p) to field $y because that name is already in use at - line 8. +######## +use strict; +no warnings 'experimental::class'; +use feature 'class'; +class XXX { + my $classname = __CLASS__; +} +EXPECT +Cannot use __CLASS__ outside of a method or field initializer expression at - line 5. diff --git a/t/op/coreamp.t b/t/op/coreamp.t index 588b4ed50552..ac37fffc69cf 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -303,6 +303,7 @@ undef *_; $tests++; pass('no crash with &CORE::foo when *_{ARRAY} is undef'); +test_proto '__CLASS__'; test_proto '__FILE__'; test_proto '__LINE__'; test_proto '__PACKAGE__'; diff --git a/t/op/coresubs.t b/t/op/coresubs.t index f101771ea5e3..80f5cd8f0121 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -73,6 +73,8 @@ while(<$kh>) { inlinable_ok($word, $args_for{$word} || join ",", map "\$$_", 1..$numargs); + next if $word eq "__CLASS__"; + # High-precedence tests my $hpcode; if (!$proto && defined $proto) { # nullary @@ -138,13 +140,29 @@ sub inlinable_ok { for ([with => "($args)"], [without => " $args"]) { my ($preposition, $full_args) = @$_; - my $core_code = - "#line 1 This-line-makes-__FILE__-easier-to-test. - sub { () = (CORE::$word$full_args) }"; - my $my_code = $core_code =~ s/CORE::$word/my$word/r; + my $core_code; + if($word eq "__CLASS__") { + use feature 'state'; + state $classcount = 1; + # __CLASS__ is only valid inside a method of a class + $core_code = + "#line 1 This-line-makes-__FILE__-easier-to-test. + use feature 'class'; + no warnings 'experimental::class'; + class TmpClassA$classcount { method { () = (CORE::$word$full_args) } }"; + $classcount++; + } + else { + $core_code = + "#line 1 This-line-makes-__FILE__-easier-to-test. + sub { () = (CORE::$word$full_args) }"; + } + my $my_code = $core_code =~ s/CORE::$word/::my$word/r; + $my_code =~ s/TmpClassA/TmpClassB/; my $core = op_list(eval $core_code or die); my $my = op_list(eval $my_code or die); is $my, $core, "inlinability of CORE::$word $preposition parens $desc_suffix"; + } } diff --git a/toke.c b/toke.c index 1f81b3614c9a..014fe43f883d 100644 --- a/toke.c +++ b/toke.c @@ -7820,6 +7820,9 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct ? newOP(OP_RUNCV, 0) : newSVOP(OP_RUNCV, 0, &PL_sv_undef)); + case KEY___CLASS__: + FUN0(OP_CLASSNAME); + case KEY_AUTOLOAD: case KEY_DESTROY: case KEY_BEGIN: