From: Alexander Gough Date: Thu, 19 Oct 2006 13:04:12 +0000 (+0100) Subject: stab at UNITCHECK blocks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3c10abe350e3df50f8ef0ac37c9d14175bc899f1;p=p5sagit%2Fp5-mst-13.2.git stab at UNITCHECK blocks Message-ID: <20061019120412.GA12290@the.earth.li> p4raw-id: //depot/perl@29053 --- diff --git a/MANIFEST b/MANIFEST index a9cf92a..83f15f2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3370,6 +3370,7 @@ t/op/attrs.t See if attributes on declarations work t/op/auto.t See if autoincrement et all work t/op/avhv.t See if pseudo-hashes work t/op/bless.t See if bless works +t/op/blocks.t See if BEGIN and friends work t/op/bop.t See if bitops work t/op/caller.pl Tests shared between caller.t and XS op.t t/op/caller.t See if caller() works diff --git a/cv.h b/cv.h index 65a3457..2673bcc 100644 --- a/cv.h +++ b/cv.h @@ -185,7 +185,7 @@ Returns the stash of the CV. #define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv)) #define CvEVAL_off(cv) CvUNIQUE_off(cv) -/* BEGIN|CHECK|INIT|END */ +/* BEGIN|CHECK|INIT|UNITCHECK|END */ #define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv)) #define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv)) #define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv)) diff --git a/embedvar.h b/embedvar.h index 2aec5f0..7e88671 100644 --- a/embedvar.h +++ b/embedvar.h @@ -381,6 +381,8 @@ #define PL_tokenbuf (vTHX->Itokenbuf) #define PL_uid (vTHX->Iuid) #define PL_unicode (vTHX->Iunicode) +#define PL_unitcheckav (vTHX->Iunitcheckav) +#define PL_unitcheckav_save (vTHX->Iunitcheckav_save) #define PL_unlockhook (vTHX->Iunlockhook) #define PL_unsafe (vTHX->Iunsafe) #define PL_utf8_alnum (vTHX->Iutf8_alnum) @@ -677,6 +679,8 @@ #define PL_Itokenbuf PL_tokenbuf #define PL_Iuid PL_uid #define PL_Iunicode PL_unicode +#define PL_Iunitcheckav PL_unitcheckav +#define PL_Iunitcheckav_save PL_unitcheckav_save #define PL_Iunlockhook PL_unlockhook #define PL_Iunsafe PL_unsafe #define PL_Iutf8_alnum PL_utf8_alnum diff --git a/intrpvar.h b/intrpvar.h index 3d93793..8c94284 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -133,6 +133,7 @@ PERLVAR(Iglobalstash, HV *) /* global keyword overrides imported here */ PERLVAR(Icurstname, SV *) /* name of current package */ PERLVAR(Ibeginav, AV *) /* names of BEGIN subroutines */ PERLVAR(Iendav, AV *) /* names of END subroutines */ +PERLVAR(Iunitcheckav, AV *) /* names of UNITCHECK subroutines */ PERLVAR(Icheckav, AV *) /* names of CHECK subroutines */ PERLVAR(Iinitav, AV *) /* names of INIT subroutines */ PERLVAR(Istrtab, HV *) /* shared string table */ @@ -490,6 +491,7 @@ PERLVAR(Iutf8_idcont, SV *) PERLVAR(Isort_RealCmp, SVCOMPARE_t) PERLVARI(Icheckav_save, AV*, NULL) /* save CHECK{}s when compiling */ +PERLVARI(Iunitcheckav_save, AV*, NULL) /* save UNITCHECK{}s when compiling */ PERLVARI(Iclocktick, long, 0) /* this many times() ticks in a second */ diff --git a/keywords.h b/keywords.h index 45622e3..80ca4fc 100644 --- a/keywords.h +++ b/keywords.h @@ -20,250 +20,251 @@ #define KEY___END__ 5 #define KEY_AUTOLOAD 6 #define KEY_BEGIN 7 -#define KEY_CORE 8 -#define KEY_DESTROY 9 -#define KEY_END 10 -#define KEY_INIT 11 -#define KEY_CHECK 12 -#define KEY_abs 13 -#define KEY_accept 14 -#define KEY_alarm 15 -#define KEY_and 16 -#define KEY_atan2 17 -#define KEY_bind 18 -#define KEY_binmode 19 -#define KEY_bless 20 -#define KEY_break 21 -#define KEY_caller 22 -#define KEY_chdir 23 -#define KEY_chmod 24 -#define KEY_chomp 25 -#define KEY_chop 26 -#define KEY_chown 27 -#define KEY_chr 28 -#define KEY_chroot 29 -#define KEY_close 30 -#define KEY_closedir 31 -#define KEY_cmp 32 -#define KEY_connect 33 -#define KEY_continue 34 -#define KEY_cos 35 -#define KEY_crypt 36 -#define KEY_dbmclose 37 -#define KEY_dbmopen 38 -#define KEY_default 39 -#define KEY_defined 40 -#define KEY_delete 41 -#define KEY_die 42 -#define KEY_do 43 -#define KEY_dump 44 -#define KEY_each 45 -#define KEY_else 46 -#define KEY_elsif 47 -#define KEY_endgrent 48 -#define KEY_endhostent 49 -#define KEY_endnetent 50 -#define KEY_endprotoent 51 -#define KEY_endpwent 52 -#define KEY_endservent 53 -#define KEY_eof 54 -#define KEY_eq 55 -#define KEY_err 56 -#define KEY_eval 57 -#define KEY_exec 58 -#define KEY_exists 59 -#define KEY_exit 60 -#define KEY_exp 61 -#define KEY_fcntl 62 -#define KEY_fileno 63 -#define KEY_flock 64 -#define KEY_for 65 -#define KEY_foreach 66 -#define KEY_fork 67 -#define KEY_format 68 -#define KEY_formline 69 -#define KEY_ge 70 -#define KEY_getc 71 -#define KEY_getgrent 72 -#define KEY_getgrgid 73 -#define KEY_getgrnam 74 -#define KEY_gethostbyaddr 75 -#define KEY_gethostbyname 76 -#define KEY_gethostent 77 -#define KEY_getlogin 78 -#define KEY_getnetbyaddr 79 -#define KEY_getnetbyname 80 -#define KEY_getnetent 81 -#define KEY_getpeername 82 -#define KEY_getpgrp 83 -#define KEY_getppid 84 -#define KEY_getpriority 85 -#define KEY_getprotobyname 86 -#define KEY_getprotobynumber 87 -#define KEY_getprotoent 88 -#define KEY_getpwent 89 -#define KEY_getpwnam 90 -#define KEY_getpwuid 91 -#define KEY_getservbyname 92 -#define KEY_getservbyport 93 -#define KEY_getservent 94 -#define KEY_getsockname 95 -#define KEY_getsockopt 96 -#define KEY_given 97 -#define KEY_glob 98 -#define KEY_gmtime 99 -#define KEY_goto 100 -#define KEY_grep 101 -#define KEY_gt 102 -#define KEY_hex 103 -#define KEY_if 104 -#define KEY_index 105 -#define KEY_int 106 -#define KEY_ioctl 107 -#define KEY_join 108 -#define KEY_keys 109 -#define KEY_kill 110 -#define KEY_last 111 -#define KEY_lc 112 -#define KEY_lcfirst 113 -#define KEY_le 114 -#define KEY_length 115 -#define KEY_link 116 -#define KEY_listen 117 -#define KEY_local 118 -#define KEY_localtime 119 -#define KEY_lock 120 -#define KEY_log 121 -#define KEY_lstat 122 -#define KEY_lt 123 -#define KEY_m 124 -#define KEY_map 125 -#define KEY_mkdir 126 -#define KEY_msgctl 127 -#define KEY_msgget 128 -#define KEY_msgrcv 129 -#define KEY_msgsnd 130 -#define KEY_my 131 -#define KEY_ne 132 -#define KEY_next 133 -#define KEY_no 134 -#define KEY_not 135 -#define KEY_oct 136 -#define KEY_open 137 -#define KEY_opendir 138 -#define KEY_or 139 -#define KEY_ord 140 -#define KEY_our 141 -#define KEY_pack 142 -#define KEY_package 143 -#define KEY_pipe 144 -#define KEY_pop 145 -#define KEY_pos 146 -#define KEY_print 147 -#define KEY_printf 148 -#define KEY_prototype 149 -#define KEY_push 150 -#define KEY_q 151 -#define KEY_qq 152 -#define KEY_qr 153 -#define KEY_quotemeta 154 -#define KEY_qw 155 -#define KEY_qx 156 -#define KEY_rand 157 -#define KEY_read 158 -#define KEY_readdir 159 -#define KEY_readline 160 -#define KEY_readlink 161 -#define KEY_readpipe 162 -#define KEY_recv 163 -#define KEY_redo 164 -#define KEY_ref 165 -#define KEY_rename 166 -#define KEY_require 167 -#define KEY_reset 168 -#define KEY_return 169 -#define KEY_reverse 170 -#define KEY_rewinddir 171 -#define KEY_rindex 172 -#define KEY_rmdir 173 -#define KEY_s 174 -#define KEY_say 175 -#define KEY_scalar 176 -#define KEY_seek 177 -#define KEY_seekdir 178 -#define KEY_select 179 -#define KEY_semctl 180 -#define KEY_semget 181 -#define KEY_semop 182 -#define KEY_send 183 -#define KEY_setgrent 184 -#define KEY_sethostent 185 -#define KEY_setnetent 186 -#define KEY_setpgrp 187 -#define KEY_setpriority 188 -#define KEY_setprotoent 189 -#define KEY_setpwent 190 -#define KEY_setservent 191 -#define KEY_setsockopt 192 -#define KEY_shift 193 -#define KEY_shmctl 194 -#define KEY_shmget 195 -#define KEY_shmread 196 -#define KEY_shmwrite 197 -#define KEY_shutdown 198 -#define KEY_sin 199 -#define KEY_sleep 200 -#define KEY_socket 201 -#define KEY_socketpair 202 -#define KEY_sort 203 -#define KEY_splice 204 -#define KEY_split 205 -#define KEY_sprintf 206 -#define KEY_sqrt 207 -#define KEY_srand 208 -#define KEY_stat 209 -#define KEY_state 210 -#define KEY_study 211 -#define KEY_sub 212 -#define KEY_substr 213 -#define KEY_symlink 214 -#define KEY_syscall 215 -#define KEY_sysopen 216 -#define KEY_sysread 217 -#define KEY_sysseek 218 -#define KEY_system 219 -#define KEY_syswrite 220 -#define KEY_tell 221 -#define KEY_telldir 222 -#define KEY_tie 223 -#define KEY_tied 224 -#define KEY_time 225 -#define KEY_times 226 -#define KEY_tr 227 -#define KEY_truncate 228 -#define KEY_uc 229 -#define KEY_ucfirst 230 -#define KEY_umask 231 -#define KEY_undef 232 -#define KEY_unless 233 -#define KEY_unlink 234 -#define KEY_unpack 235 -#define KEY_unshift 236 -#define KEY_untie 237 -#define KEY_until 238 -#define KEY_use 239 -#define KEY_utime 240 -#define KEY_values 241 -#define KEY_vec 242 -#define KEY_wait 243 -#define KEY_waitpid 244 -#define KEY_wantarray 245 -#define KEY_warn 246 -#define KEY_when 247 -#define KEY_while 248 -#define KEY_write 249 -#define KEY_x 250 -#define KEY_xor 251 -#define KEY_y 252 +#define KEY_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_err 57 +#define KEY_eval 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 /* ex: set ro: */ diff --git a/keywords.pl b/keywords.pl index 441d04b..fa8a282 100755 --- a/keywords.pl +++ b/keywords.pl @@ -55,6 +55,7 @@ __DATA__ __END__ AUTOLOAD BEGIN +UNITCHECK CORE DESTROY END diff --git a/madly.act b/madly.act index 788efa8..d7d9936 100644 --- a/madly.act +++ b/madly.act @@ -495,63 +495,64 @@ case 2: #line 499 "madly.y" { const char *const name = SvPV_nolen_const(((SVOP*)(yyvsp[0].opval))->op_sv); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT") || strEQ(name, "CHECK")) + || strEQ(name, "INIT") || strEQ(name, "CHECK") + || strEQ(name, "UNITCHECK")) CvSPECIAL_on(PL_compcv); (yyval.opval) = (yyvsp[0].opval); ;} break; case 70: -#line 508 "madly.y" +#line 509 "madly.y" { (yyval.opval) = Nullop; ;} break; case 72: -#line 514 "madly.y" +#line 515 "madly.y" { (yyval.opval) = Nullop; ;} break; case 73: -#line 516 "madly.y" +#line 517 "madly.y" { (yyval.opval) = (yyvsp[0].opval); token_getmad((yyvsp[-1].tkval),(yyval.opval),':'); ;} break; case 74: -#line 520 "madly.y" +#line 521 "madly.y" { (yyval.opval) = newOP(OP_NULL, 0); token_getmad((yyvsp[0].tkval),(yyval.opval),':'); ;} break; case 75: -#line 527 "madly.y" +#line 528 "madly.y" { (yyval.opval) = (yyvsp[0].opval); token_getmad((yyvsp[-1].tkval),(yyval.opval),':'); ;} break; case 76: -#line 531 "madly.y" +#line 532 "madly.y" { (yyval.opval) = newOP(OP_NULL, 0); token_getmad((yyvsp[0].tkval),(yyval.opval),':'); ;} break; case 77: -#line 537 "madly.y" +#line 538 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 78: -#line 538 "madly.y" +#line 539 "madly.y" { (yyval.opval) = newOP(OP_NULL,0); PL_expect = XSTATE; token_getmad((yyvsp[0].tkval),(yyval.opval),';'); ;} break; case 79: -#line 544 "madly.y" +#line 545 "madly.y" { (yyval.opval) = package((yyvsp[-1].opval)); token_getmad((yyvsp[-2].tkval),(yyval.opval),'o'); token_getmad((yyvsp[0].tkval),(yyval.opval),';'); @@ -559,12 +560,12 @@ case 2: break; case 80: -#line 551 "madly.y" +#line 552 "madly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ ;} break; case 81: -#line 553 "madly.y" +#line 554 "madly.y" { SvREFCNT_inc(PL_compcv); (yyval.opval) = utilize(((yyvsp[-6].tkval))->tk_lval.ival, (yyvsp[-5].ival), (yyvsp[-3].opval), (yyvsp[-2].opval), (yyvsp[-1].opval)); token_getmad((yyvsp[-6].tkval),(yyval.opval),'o'); @@ -575,28 +576,28 @@ case 2: break; case 82: -#line 564 "madly.y" +#line 565 "madly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 83: -#line 568 "madly.y" +#line 569 "madly.y" { (yyval.opval) = newLOGOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 84: -#line 572 "madly.y" +#line 573 "madly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 86: -#line 580 "madly.y" +#line 581 "madly.y" { OP* op = newNULLLIST(); token_getmad((yyvsp[0].tkval),op,','); (yyval.opval) = append_elem(OP_LIST, (yyvsp[-1].opval), op); @@ -604,7 +605,7 @@ case 2: break; case 87: -#line 585 "madly.y" +#line 586 "madly.y" { (yyvsp[0].opval) = newUNOP(OP_NULL, 0, (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyvsp[0].opval),','); @@ -613,7 +614,7 @@ case 2: break; case 89: -#line 595 "madly.y" +#line 596 "madly.y" { (yyval.opval) = convert(((yyvsp[-2].tkval))->tk_lval.ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(((yyvsp[-2].tkval))->tk_lval.ival,(yyvsp[-1].opval)), (yyvsp[0].opval)) ); token_getmad((yyvsp[-2].tkval),(yyval.opval),'o'); @@ -621,7 +622,7 @@ case 2: break; case 90: -#line 600 "madly.y" +#line 601 "madly.y" { (yyval.opval) = convert(((yyvsp[-4].tkval))->tk_lval.ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(((yyvsp[-4].tkval))->tk_lval.ival,(yyvsp[-2].opval)), (yyvsp[-1].opval)) ); token_getmad((yyvsp[-4].tkval),(yyval.opval),'o'); @@ -631,7 +632,7 @@ case 2: break; case 91: -#line 607 "madly.y" +#line 608 "madly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, scalar((yyvsp[-5].opval)), (yyvsp[-1].opval)), @@ -643,7 +644,7 @@ case 2: break; case 92: -#line 616 "madly.y" +#line 617 "madly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, scalar((yyvsp[-2].opval)), newUNOP(OP_METHOD, 0, (yyvsp[0].opval)))); @@ -652,7 +653,7 @@ case 2: break; case 93: -#line 622 "madly.y" +#line 623 "madly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, (yyvsp[-1].opval), (yyvsp[0].opval)), @@ -661,7 +662,7 @@ case 2: break; case 94: -#line 628 "madly.y" +#line 629 "madly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, (yyvsp[-3].opval), (yyvsp[-1].opval)), @@ -672,14 +673,14 @@ case 2: break; case 95: -#line 636 "madly.y" +#line 637 "madly.y" { (yyval.opval) = convert(((yyvsp[-1].tkval))->tk_lval.ival, 0, (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 96: -#line 640 "madly.y" +#line 641 "madly.y" { (yyval.opval) = convert(((yyvsp[-3].tkval))->tk_lval.ival, 0, (yyvsp[-1].opval)); token_getmad((yyvsp[-3].tkval),(yyval.opval),'o'); token_getmad((yyvsp[-2].tkval),(yyval.opval),'('); @@ -688,13 +689,13 @@ case 2: break; case 97: -#line 646 "madly.y" +#line 647 "madly.y" { SvREFCNT_inc(PL_compcv); (yyvsp[0].opval) = newANONATTRSUB((yyvsp[-1].ival), 0, Nullop, (yyvsp[0].opval)); ;} break; case 98: -#line 649 "madly.y" +#line 650 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, (yyvsp[-2].opval), (yyvsp[0].opval)), (yyvsp[-4].opval))); @@ -702,7 +703,7 @@ case 2: break; case 101: -#line 664 "madly.y" +#line 665 "madly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (yyvsp[-4].opval), scalar((yyvsp[-2].opval))); PL_expect = XOPERATOR; token_getmad((yyvsp[-3].tkval),(yyval.opval),'{'); @@ -712,7 +713,7 @@ case 2: break; case 102: -#line 671 "madly.y" +#line 672 "madly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((yyvsp[-3].opval)), scalar((yyvsp[-1].opval))); token_getmad((yyvsp[-2].tkval),(yyval.opval),'['); token_getmad((yyvsp[0].tkval),(yyval.opval),']'); @@ -720,7 +721,7 @@ case 2: break; case 103: -#line 676 "madly.y" +#line 677 "madly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((yyvsp[-4].opval)),OP_RV2AV), scalar((yyvsp[-1].opval))); @@ -731,7 +732,7 @@ case 2: break; case 104: -#line 684 "madly.y" +#line 685 "madly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((yyvsp[-3].opval)),OP_RV2AV), scalar((yyvsp[-1].opval))); @@ -741,7 +742,7 @@ case 2: break; case 105: -#line 691 "madly.y" +#line 692 "madly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((yyvsp[-4].opval)), jmaybe((yyvsp[-2].opval))); PL_expect = XOPERATOR; token_getmad((yyvsp[-3].tkval),(yyval.opval),'{'); @@ -751,7 +752,7 @@ case 2: break; case 106: -#line 698 "madly.y" +#line 699 "madly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((yyvsp[-5].opval)),OP_RV2HV), jmaybe((yyvsp[-2].opval))); @@ -764,7 +765,7 @@ case 2: break; case 107: -#line 708 "madly.y" +#line 709 "madly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((yyvsp[-4].opval)),OP_RV2HV), jmaybe((yyvsp[-2].opval))); @@ -776,7 +777,7 @@ case 2: break; case 108: -#line 717 "madly.y" +#line 718 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((yyvsp[-3].opval)))); token_getmad((yyvsp[-2].tkval),(yyval.opval),'a'); @@ -786,7 +787,7 @@ case 2: break; case 109: -#line 724 "madly.y" +#line 725 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[-1].opval), newCVREF(0, scalar((yyvsp[-4].opval))))); @@ -797,7 +798,7 @@ case 2: break; case 110: -#line 733 "madly.y" +#line 734 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[-1].opval), newCVREF(0, scalar((yyvsp[-3].opval))))); @@ -807,7 +808,7 @@ case 2: break; case 111: -#line 740 "madly.y" +#line 741 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((yyvsp[-2].opval)))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'('); @@ -816,7 +817,7 @@ case 2: break; case 112: -#line 746 "madly.y" +#line 747 "madly.y" { (yyval.opval) = newSLICEOP(0, (yyvsp[-1].opval), (yyvsp[-4].opval)); token_getmad((yyvsp[-5].tkval),(yyval.opval),'('); token_getmad((yyvsp[-3].tkval),(yyval.opval),')'); @@ -826,7 +827,7 @@ case 2: break; case 113: -#line 753 "madly.y" +#line 754 "madly.y" { (yyval.opval) = newSLICEOP(0, (yyvsp[-1].opval), Nullop); token_getmad((yyvsp[-4].tkval),(yyval.opval),'('); token_getmad((yyvsp[-3].tkval),(yyval.opval),')'); @@ -836,21 +837,21 @@ case 2: break; case 114: -#line 763 "madly.y" +#line 764 "madly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (yyvsp[-2].opval), ((yyvsp[-1].tkval))->tk_lval.ival, (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 115: -#line 767 "madly.y" +#line 768 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 116: -#line 771 "madly.y" +#line 772 "madly.y" { if (((yyvsp[-1].tkval))->tk_lval.ival != OP_REPEAT) scalar((yyvsp[-2].opval)); (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, (yyvsp[-2].opval), scalar((yyvsp[0].opval))); @@ -859,49 +860,49 @@ case 2: break; case 117: -#line 777 "madly.y" +#line 778 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 118: -#line 781 "madly.y" +#line 782 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 119: -#line 785 "madly.y" +#line 786 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 120: -#line 789 "madly.y" +#line 790 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 121: -#line 793 "madly.y" +#line 794 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 122: -#line 797 "madly.y" +#line 798 "madly.y" { (yyval.opval) = newBINOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 123: -#line 801 "madly.y" +#line 802 "madly.y" { UNOP *op; (yyval.opval) = newRANGE(((yyvsp[-1].tkval))->tk_lval.ival, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); op = (UNOP*)(yyval.opval); @@ -913,28 +914,28 @@ case 2: break; case 124: -#line 810 "madly.y" +#line 811 "madly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 125: -#line 814 "madly.y" +#line 815 "madly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 126: -#line 818 "madly.y" +#line 819 "madly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 127: -#line 822 "madly.y" +#line 823 "madly.y" { (yyval.opval) = bind_match(((yyvsp[-1].tkval))->tk_lval.ival, (yyvsp[-2].opval), (yyvsp[0].opval)); if ((yyval.opval)->op_type == OP_NOT) token_getmad((yyvsp[-1].tkval),((UNOP*)(yyval.opval))->op_first,'~'); @@ -944,35 +945,35 @@ case 2: break; case 128: -#line 832 "madly.y" +#line 833 "madly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 129: -#line 836 "madly.y" +#line 837 "madly.y" { (yyval.opval) = newUNOP(OP_NULL, 0, (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'+'); ;} break; case 130: -#line 840 "madly.y" +#line 841 "madly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 131: -#line 844 "madly.y" +#line 845 "madly.y" { (yyval.opval) = newUNOP(OP_COMPLEMENT, 0, scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 132: -#line 848 "madly.y" +#line 849 "madly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, mod(scalar((yyvsp[-1].opval)), OP_POSTINC)); token_getmad((yyvsp[0].tkval),(yyval.opval),'o'); @@ -980,7 +981,7 @@ case 2: break; case 133: -#line 853 "madly.y" +#line 854 "madly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, mod(scalar((yyvsp[-1].opval)), OP_POSTDEC)); token_getmad((yyvsp[0].tkval),(yyval.opval),'o'); @@ -988,7 +989,7 @@ case 2: break; case 134: -#line 858 "madly.y" +#line 859 "madly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, mod(scalar((yyvsp[0].opval)), OP_PREINC)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); @@ -996,7 +997,7 @@ case 2: break; case 135: -#line 863 "madly.y" +#line 864 "madly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, mod(scalar((yyvsp[0].opval)), OP_PREDEC)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); @@ -1004,7 +1005,7 @@ case 2: break; case 136: -#line 872 "madly.y" +#line 873 "madly.y" { (yyval.opval) = newANONLIST((yyvsp[-1].opval)); token_getmad((yyvsp[-2].tkval),(yyval.opval),'['); token_getmad((yyvsp[0].tkval),(yyval.opval),']'); @@ -1012,7 +1013,7 @@ case 2: break; case 137: -#line 877 "madly.y" +#line 878 "madly.y" { (yyval.opval) = newANONLIST(Nullop); token_getmad((yyvsp[-1].tkval),(yyval.opval),'['); token_getmad((yyvsp[0].tkval),(yyval.opval),']'); @@ -1020,7 +1021,7 @@ case 2: break; case 138: -#line 882 "madly.y" +#line 883 "madly.y" { (yyval.opval) = newANONHASH((yyvsp[-2].opval)); token_getmad((yyvsp[-3].tkval),(yyval.opval),'{'); token_getmad((yyvsp[-1].tkval),(yyval.opval),';'); @@ -1029,7 +1030,7 @@ case 2: break; case 139: -#line 888 "madly.y" +#line 889 "madly.y" { (yyval.opval) = newANONHASH(Nullop); token_getmad((yyvsp[-2].tkval),(yyval.opval),'{'); token_getmad((yyvsp[-1].tkval),(yyval.opval),';'); @@ -1038,7 +1039,7 @@ case 2: break; case 140: -#line 894 "madly.y" +#line 895 "madly.y" { SvREFCNT_inc(PL_compcv); (yyval.opval) = newANONATTRSUB((yyvsp[-3].ival), (yyvsp[-2].opval), (yyvsp[-1].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-4].tkval),(yyval.opval),'o'); @@ -1048,21 +1049,21 @@ case 2: break; case 141: -#line 905 "madly.y" +#line 906 "madly.y" { (yyval.opval) = dofile((yyvsp[0].opval), (yyvsp[-1].tkval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 142: -#line 909 "madly.y" +#line 910 "madly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, scope((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'D'); ;} break; case 143: -#line 913 "madly.y" +#line 914 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -1077,7 +1078,7 @@ case 2: break; case 144: -#line 925 "madly.y" +#line 926 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -1093,7 +1094,7 @@ case 2: break; case 145: -#line 938 "madly.y" +#line 939 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar((yyvsp[-2].opval)))), Nullop)); dep(); @@ -1104,7 +1105,7 @@ case 2: break; case 146: -#line 946 "madly.y" +#line 947 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, (yyvsp[-1].opval), @@ -1116,7 +1117,7 @@ case 2: break; case 151: -#line 962 "madly.y" +#line 963 "madly.y" { (yyval.opval) = newCONDOP(0, (yyvsp[-4].opval), (yyvsp[-2].opval), (yyvsp[0].opval)); token_getmad((yyvsp[-3].tkval),(yyval.opval),'?'); token_getmad((yyvsp[-1].tkval),(yyval.opval),':'); @@ -1124,26 +1125,26 @@ case 2: break; case 152: -#line 967 "madly.y" +#line 968 "madly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, mod((yyvsp[0].opval),OP_REFGEN)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 153: -#line 971 "madly.y" +#line 972 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 154: -#line 973 "madly.y" +#line 974 "madly.y" { (yyval.opval) = localize((yyvsp[0].opval),((yyvsp[-1].tkval))->tk_lval.ival); token_getmad((yyvsp[-1].tkval),(yyval.opval),'d'); ;} break; case 155: -#line 977 "madly.y" +#line 978 "madly.y" { (yyval.opval) = sawparens(newUNOP(OP_NULL,0,(yyvsp[-1].opval))); token_getmad((yyvsp[-2].tkval),(yyval.opval),'('); token_getmad((yyvsp[0].tkval),(yyval.opval),')'); @@ -1151,7 +1152,7 @@ case 2: break; case 156: -#line 982 "madly.y" +#line 983 "madly.y" { (yyval.opval) = sawparens(newNULLLIST()); token_getmad((yyvsp[-1].tkval),(yyval.opval),'('); token_getmad((yyvsp[0].tkval),(yyval.opval),')'); @@ -1159,37 +1160,37 @@ case 2: break; case 157: -#line 987 "madly.y" +#line 988 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 158: -#line 989 "madly.y" +#line 990 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 159: -#line 991 "madly.y" +#line 992 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 160: -#line 993 "madly.y" +#line 994 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 161: -#line 995 "madly.y" +#line 996 "madly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((yyvsp[0].opval), OP_AV2ARYLEN));;} break; case 162: -#line 997 "madly.y" +#line 998 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 163: -#line 999 "madly.y" +#line 1000 "madly.y" { (yyval.opval) = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1201,7 +1202,7 @@ case 2: break; case 164: -#line 1008 "madly.y" +#line 1009 "madly.y" { (yyval.opval) = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1215,17 +1216,17 @@ case 2: break; case 165: -#line 1019 "madly.y" +#line 1020 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 166: -#line 1021 "madly.y" +#line 1022 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((yyvsp[0].opval))); ;} break; case 167: -#line 1023 "madly.y" +#line 1024 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((yyvsp[-2].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'('); token_getmad((yyvsp[0].tkval),(yyval.opval),')'); @@ -1233,7 +1234,7 @@ case 2: break; case 168: -#line 1028 "madly.y" +#line 1029 "madly.y" { OP* op; (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[-1].opval), scalar((yyvsp[-3].opval)))); @@ -1247,7 +1248,7 @@ case 2: break; case 169: -#line 1039 "madly.y" +#line 1040 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[0].opval), scalar((yyvsp[-1].opval)))); token_getmad((yyvsp[-2].tkval),(yyval.opval),'o'); @@ -1255,7 +1256,7 @@ case 2: break; case 170: -#line 1044 "madly.y" +#line 1045 "madly.y" { (yyval.opval) = newOP(((yyvsp[0].tkval))->tk_lval.ival, OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; token_getmad((yyvsp[0].tkval),(yyval.opval),'o'); @@ -1263,65 +1264,65 @@ case 2: break; case 171: -#line 1049 "madly.y" +#line 1050 "madly.y" { (yyval.opval) = newLOOPEX(((yyvsp[-1].tkval))->tk_lval.ival,(yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 172: -#line 1053 "madly.y" +#line 1054 "madly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((yyvsp[0].opval))); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 173: -#line 1057 "madly.y" +#line 1058 "madly.y" { (yyval.opval) = newOP(((yyvsp[0].tkval))->tk_lval.ival, 0); token_getmad((yyvsp[0].tkval),(yyval.opval),'o'); ;} break; case 174: -#line 1061 "madly.y" +#line 1062 "madly.y" { (yyval.opval) = newUNOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 175: -#line 1065 "madly.y" +#line 1066 "madly.y" { (yyval.opval) = newUNOP(((yyvsp[-1].tkval))->tk_lval.ival, 0, (yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'o'); ;} break; case 176: -#line 1069 "madly.y" +#line 1070 "madly.y" { (yyval.opval) = newOP(OP_REQUIRE, (yyvsp[0].tkval) ? OPf_SPECIAL : 0); ;} break; case 177: -#line 1071 "madly.y" +#line 1072 "madly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (yyvsp[-1].tkval) ? OPf_SPECIAL : 0, (yyvsp[0].opval)); ;} break; case 178: -#line 1073 "madly.y" +#line 1074 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[0].opval), scalar((yyvsp[-1].opval)))); ;} break; case 179: -#line 1076 "madly.y" +#line 1077 "madly.y" { (yyval.opval) = newOP(((yyvsp[0].tkval))->tk_lval.ival, 0); token_getmad((yyvsp[0].tkval),(yyval.opval),'o'); ;} break; case 180: -#line 1080 "madly.y" +#line 1081 "madly.y" { (yyval.opval) = newOP(((yyvsp[-2].tkval))->tk_lval.ival, 0); token_getmad((yyvsp[-2].tkval),(yyval.opval),'o'); token_getmad((yyvsp[-1].tkval),(yyval.opval),'('); @@ -1330,13 +1331,13 @@ case 2: break; case 181: -#line 1086 "madly.y" +#line 1087 "madly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((yyvsp[0].opval))); ;} break; case 182: -#line 1089 "madly.y" +#line 1090 "madly.y" { (yyval.opval) = newOP(((yyvsp[-2].tkval))->tk_lval.ival, OPf_SPECIAL); token_getmad((yyvsp[-2].tkval),(yyval.opval),'o'); token_getmad((yyvsp[-1].tkval),(yyval.opval),'('); @@ -1345,7 +1346,7 @@ case 2: break; case 183: -#line 1095 "madly.y" +#line 1096 "madly.y" { (yyval.opval) = newUNOP(((yyvsp[-3].tkval))->tk_lval.ival, 0, (yyvsp[-1].opval)); token_getmad((yyvsp[-3].tkval),(yyval.opval),'o'); token_getmad((yyvsp[-2].tkval),(yyval.opval),'('); @@ -1354,7 +1355,7 @@ case 2: break; case 184: -#line 1101 "madly.y" +#line 1102 "madly.y" { (yyval.opval) = pmruntime((yyvsp[-3].opval), (yyvsp[-1].opval), 1); token_getmad((yyvsp[-2].tkval),(yyval.opval),'('); token_getmad((yyvsp[0].tkval),(yyval.opval),')'); @@ -1362,7 +1363,7 @@ case 2: break; case 187: -#line 1111 "madly.y" +#line 1112 "madly.y" { (yyval.opval) = my_attrs((yyvsp[-1].opval),(yyvsp[0].opval)); token_getmad((yyvsp[-2].tkval),(yyval.opval),'d'); append_madprops((yyvsp[0].opval)->op_madprop, (yyval.opval), 'a'); @@ -1371,14 +1372,14 @@ case 2: break; case 188: -#line 1117 "madly.y" +#line 1118 "madly.y" { (yyval.opval) = localize((yyvsp[0].opval),((yyvsp[-1].tkval))->tk_lval.ival); token_getmad((yyvsp[-1].tkval),(yyval.opval),'d'); ;} break; case 189: -#line 1124 "madly.y" +#line 1125 "madly.y" { (yyval.opval) = sawparens((yyvsp[-1].opval)); token_getmad((yyvsp[-2].tkval),(yyval.opval),'('); token_getmad((yyvsp[0].tkval),(yyval.opval),')'); @@ -1386,7 +1387,7 @@ case 2: break; case 190: -#line 1129 "madly.y" +#line 1130 "madly.y" { (yyval.opval) = sawparens(newNULLLIST()); token_getmad((yyvsp[-1].tkval),(yyval.opval),'('); token_getmad((yyvsp[0].tkval),(yyval.opval),')'); @@ -1394,42 +1395,42 @@ case 2: break; case 191: -#line 1134 "madly.y" +#line 1135 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 192: -#line 1136 "madly.y" +#line 1137 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 193: -#line 1138 "madly.y" +#line 1139 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 194: -#line 1143 "madly.y" +#line 1144 "madly.y" { (yyval.opval) = Nullop; ;} break; case 195: -#line 1145 "madly.y" +#line 1146 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 196: -#line 1149 "madly.y" +#line 1150 "madly.y" { (yyval.opval) = Nullop; ;} break; case 197: -#line 1151 "madly.y" +#line 1152 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 198: -#line 1153 "madly.y" +#line 1154 "madly.y" { OP* op = newNULLLIST(); token_getmad((yyvsp[0].tkval),op,','); (yyval.opval) = append_elem(OP_LIST, (yyvsp[-1].opval), op); @@ -1437,69 +1438,69 @@ case 2: break; case 199: -#line 1162 "madly.y" +#line 1163 "madly.y" { PL_in_my = 0; (yyval.opval) = my((yyvsp[0].opval)); ;} break; case 200: -#line 1166 "madly.y" +#line 1167 "madly.y" { (yyval.opval) = newCVREF(((yyvsp[-1].tkval))->tk_lval.ival,(yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'&'); ;} break; case 201: -#line 1172 "madly.y" +#line 1173 "madly.y" { (yyval.opval) = newSVREF((yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'$'); ;} break; case 202: -#line 1178 "madly.y" +#line 1179 "madly.y" { (yyval.opval) = newAVREF((yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'@'); ;} break; case 203: -#line 1184 "madly.y" +#line 1185 "madly.y" { (yyval.opval) = newHVREF((yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'%'); ;} break; case 204: -#line 1190 "madly.y" +#line 1191 "madly.y" { (yyval.opval) = newAVREF((yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'l'); ;} break; case 205: -#line 1196 "madly.y" +#line 1197 "madly.y" { (yyval.opval) = newGVREF(0,(yyvsp[0].opval)); token_getmad((yyvsp[-1].tkval),(yyval.opval),'*'); ;} break; case 206: -#line 1203 "madly.y" +#line 1204 "madly.y" { (yyval.opval) = scalar((yyvsp[0].opval)); ;} break; case 207: -#line 1205 "madly.y" +#line 1206 "madly.y" { (yyval.opval) = scalar((yyvsp[0].opval)); ;} break; case 208: -#line 1207 "madly.y" +#line 1208 "madly.y" { (yyval.opval) = scope((yyvsp[0].opval)); ;} break; case 209: -#line 1210 "madly.y" +#line 1211 "madly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; diff --git a/madly.h b/madly.h index 450b74e..afe5e04 100644 --- a/madly.h +++ b/madly.h @@ -175,7 +175,6 @@ #endif /* PERL_CORE */ #if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED) -#line 22 "madly.y" typedef union YYSTYPE { I32 ival; char *pval; @@ -184,7 +183,6 @@ typedef union YYSTYPE { GV *gvval; } YYSTYPE; /* Line 1447 of yacc.c. */ -#line 186 "madly.h" # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 # define YYSTYPE_IS_TRIVIAL 1 diff --git a/madly.tab b/madly.tab index f89e7a3..ec58c14 100644 --- a/madly.tab +++ b/madly.tab @@ -172,20 +172,20 @@ static const unsigned short int yyrline[] = 337, 362, 370, 380, 386, 387, 392, 395, 399, 404, 408, 412, 418, 421, 425, 427, 429, 431, 433, 435, 439, 445, 454, 455, 459, 467, 483, 489, 494, 499, - 508, 509, 514, 515, 519, 526, 530, 537, 538, 543, - 551, 550, 563, 567, 571, 575, 579, 584, 590, 594, - 599, 606, 615, 621, 627, 635, 639, 646, 645, 656, - 657, 661, 670, 675, 683, 690, 697, 707, 716, 723, - 732, 739, 745, 752, 762, 766, 770, 776, 780, 784, - 788, 792, 796, 800, 809, 813, 817, 821, 831, 835, - 839, 843, 847, 852, 857, 862, 871, 876, 881, 887, - 893, 904, 908, 912, 924, 937, 945, 957, 958, 959, - 960, 961, 966, 970, 972, 976, 981, 986, 988, 990, - 992, 994, 996, 998, 1007, 1018, 1020, 1022, 1027, 1038, - 1043, 1048, 1052, 1056, 1060, 1064, 1068, 1070, 1072, 1075, - 1079, 1085, 1088, 1094, 1100, 1105, 1106, 1110, 1116, 1123, - 1128, 1133, 1135, 1137, 1142, 1144, 1149, 1150, 1152, 1161, - 1165, 1171, 1177, 1183, 1189, 1195, 1202, 1204, 1206, 1209 + 509, 510, 515, 516, 520, 527, 531, 538, 539, 544, + 552, 551, 564, 568, 572, 576, 580, 585, 591, 595, + 600, 607, 616, 622, 628, 636, 640, 647, 646, 657, + 658, 662, 671, 676, 684, 691, 698, 708, 717, 724, + 733, 740, 746, 753, 763, 767, 771, 777, 781, 785, + 789, 793, 797, 801, 810, 814, 818, 822, 832, 836, + 840, 844, 848, 853, 858, 863, 872, 877, 882, 888, + 894, 905, 909, 913, 925, 938, 946, 958, 959, 960, + 961, 962, 967, 971, 973, 977, 982, 987, 989, 991, + 993, 995, 997, 999, 1008, 1019, 1021, 1023, 1028, 1039, + 1044, 1049, 1053, 1057, 1061, 1065, 1069, 1071, 1073, 1076, + 1080, 1086, 1089, 1095, 1101, 1106, 1107, 1111, 1117, 1124, + 1129, 1134, 1136, 1138, 1143, 1145, 1150, 1151, 1153, 1162, + 1166, 1172, 1178, 1184, 1190, 1196, 1203, 1205, 1207, 1210 }; #endif diff --git a/madly.y b/madly.y index 0643ff5..86a4c5e 100644 --- a/madly.y +++ b/madly.y @@ -498,7 +498,8 @@ startformsub: /* NULL */ /* start a format subroutine scope */ /* Name of a subroutine - must be a bareword, could be special */ subname : WORD { const char *const name = SvPV_nolen_const(((SVOP*)$1)->op_sv); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT") || strEQ(name, "CHECK")) + || strEQ(name, "INIT") || strEQ(name, "CHECK") + || strEQ(name, "UNITCHECK")) CvSPECIAL_on(PL_compcv); $$ = $1; } ; diff --git a/op.c b/op.c index 3dad488..66d3734 100644 --- a/op.c +++ b/op.c @@ -5342,7 +5342,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) else s = tname; - if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I') + if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I' && *s != 'U') goto done; if (strEQ(s, "BEGIN") && !PL_error_count) { @@ -5370,6 +5370,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) av_store(PL_endav, 0, (SV*)cv); GvCV(gv) = 0; /* cv has been hijacked */ } + else if (strEQ(s, "UNITCHECK") && !PL_error_count) { + /* It's never too late to run a unitcheck block */ + if (!PL_unitcheckav) + PL_unitcheckav = newAV(); + DEBUG_x( dump_sub(gv) ); + av_unshift(PL_unitcheckav, 1); + av_store(PL_unitcheckav, 0, (SV*)cv); + GvCV(gv) = 0; /* cv has been hijacked */ + } else if (strEQ(s, "CHECK") && !PL_error_count) { if (!PL_checkav) PL_checkav = newAV(); diff --git a/perl.c b/perl.c index ada96a2..7353d32 100644 --- a/perl.c +++ b/perl.c @@ -944,12 +944,16 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_endav); SvREFCNT_dec(PL_checkav); SvREFCNT_dec(PL_checkav_save); + SvREFCNT_dec(PL_unitcheckav); + SvREFCNT_dec(PL_unitcheckav_save); SvREFCNT_dec(PL_initav); PL_beginav = NULL; PL_beginav_save = NULL; PL_endav = NULL; PL_checkav = NULL; PL_checkav_save = NULL; + PL_unitcheckav = NULL; + PL_unitcheckav_save = NULL; PL_initav = NULL; /* shortcuts just get cleared */ @@ -1605,6 +1609,8 @@ setuid perl scripts securely.\n"); switch (ret) { case 0: parse_body(env,xsinit); + if (PL_unitcheckav) + call_list(oldscope, PL_unitcheckav); if (PL_checkav) call_list(oldscope, PL_checkav); ret = 0; @@ -1618,6 +1624,8 @@ setuid perl scripts securely.\n"); LEAVE; FREETMPS; PL_curstash = PL_defstash; + if (PL_unitcheckav) + call_list(oldscope, PL_unitcheckav); if (PL_checkav) call_list(oldscope, PL_checkav); ret = STATUS_EXIT; @@ -5113,6 +5121,12 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) PL_checkav_save = newAV(); av_push(PL_checkav_save, (SV*)cv); } + else if (paramList == PL_unitcheckav) { + /* save PL_unitcheckav for compiler */ + if (! PL_unitcheckav_save) + PL_unitcheckav_save = newAV(); + av_push(PL_unitcheckav_save, (SV*)cv); + } } else { if (!PL_madskills) SAVEFREESV(cv); @@ -5143,6 +5157,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) "%s failed--call queue aborted", paramList == PL_checkav ? "CHECK" : paramList == PL_initav ? "INIT" + : paramList == PL_unitcheckav ? "UNITCHECK" : "END"); while (PL_scopestack_ix > oldscope) LEAVE; @@ -5171,6 +5186,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) Perl_croak(aTHX_ "%s failed--call queue aborted", paramList == PL_checkav ? "CHECK" : paramList == PL_initav ? "INIT" + : paramList == PL_unitcheckav ? "UNITCHECK" : "END"); } my_exit_jump(); diff --git a/perl_keyword.pl b/perl_keyword.pl index ab9559c..87332ee 100644 --- a/perl_keyword.pl +++ b/perl_keyword.pl @@ -9,8 +9,8 @@ my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY default defined delete do END else eval elsif exists for format foreach given grep goto glob INIT if last local m my map next no our pos print printf package prototype q qr qq qw qx redo return require s scalar sort - split state study sub tr tie tied use undef until untie unless when - while y); + split state study sub tr tie tied use undef UNITCHECK until untie + unless when while y); my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless break bind binmode CORE cmp chr cos chop close chdir chomp chmod diff --git a/perlapi.h b/perlapi.h index 4af49dc..0aa9862 100644 --- a/perlapi.h +++ b/perlapi.h @@ -640,6 +640,10 @@ END_EXTERN_C #define PL_uid (*Perl_Iuid_ptr(aTHX)) #undef PL_unicode #define PL_unicode (*Perl_Iunicode_ptr(aTHX)) +#undef PL_unitcheckav +#define PL_unitcheckav (*Perl_Iunitcheckav_ptr(aTHX)) +#undef PL_unitcheckav_save +#define PL_unitcheckav_save (*Perl_Iunitcheckav_save_ptr(aTHX)) #undef PL_unlockhook #define PL_unlockhook (*Perl_Iunlockhook_ptr(aTHX)) #undef PL_unsafe diff --git a/perly.act b/perly.act index e2b00cd..d3e4eba 100644 --- a/perly.act +++ b/perly.act @@ -372,106 +372,107 @@ case 2: #line 380 "perly.y" { const char *const name = SvPV_nolen_const(((SVOP*)(yyvsp[0].opval))->op_sv); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT") || strEQ(name, "CHECK")) + || strEQ(name, "INIT") || strEQ(name, "CHECK") + || strEQ(name, "UNITCHECK")) CvSPECIAL_on(PL_compcv); (yyval.opval) = (yyvsp[0].opval); ;} break; case 68: -#line 389 "perly.y" +#line 390 "perly.y" { (yyval.opval) = Nullop; ;} break; case 70: -#line 395 "perly.y" +#line 396 "perly.y" { (yyval.opval) = Nullop; ;} break; case 71: -#line 397 "perly.y" +#line 398 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 72: -#line 399 "perly.y" +#line 400 "perly.y" { (yyval.opval) = Nullop; ;} break; case 73: -#line 404 "perly.y" +#line 405 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 74: -#line 406 "perly.y" +#line 407 "perly.y" { (yyval.opval) = Nullop; ;} break; case 75: -#line 410 "perly.y" +#line 411 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 76: -#line 411 "perly.y" +#line 412 "perly.y" { (yyval.opval) = Nullop; PL_expect = XSTATE; ;} break; case 77: -#line 415 "perly.y" +#line 416 "perly.y" { package((yyvsp[-1].opval)); ;} break; case 78: -#line 419 "perly.y" +#line 420 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ ;} break; case 79: -#line 421 "perly.y" +#line 422 "perly.y" { SvREFCNT_inc(PL_compcv); utilize((yyvsp[-6].ival), (yyvsp[-5].ival), (yyvsp[-3].opval), (yyvsp[-2].opval), (yyvsp[-1].opval)); ;} break; case 80: -#line 427 "perly.y" +#line 428 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 81: -#line 429 "perly.y" +#line 430 "perly.y" { (yyval.opval) = newLOGOP((yyvsp[-1].ival), 0, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 82: -#line 431 "perly.y" +#line 432 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 84: -#line 437 "perly.y" +#line 438 "perly.y" { (yyval.opval) = (yyvsp[-1].opval); ;} break; case 85: -#line 439 "perly.y" +#line 440 "perly.y" { (yyval.opval) = append_elem(OP_LIST, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 87: -#line 445 "perly.y" +#line 446 "perly.y" { (yyval.opval) = convert((yyvsp[-2].ival), OPf_STACKED, prepend_elem(OP_LIST, newGVREF((yyvsp[-2].ival),(yyvsp[-1].opval)), (yyvsp[0].opval)) ); ;} break; case 88: -#line 448 "perly.y" +#line 449 "perly.y" { (yyval.opval) = convert((yyvsp[-4].ival), OPf_STACKED, prepend_elem(OP_LIST, newGVREF((yyvsp[-4].ival),(yyvsp[-2].opval)), (yyvsp[-1].opval)) ); ;} break; case 89: -#line 451 "perly.y" +#line 452 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, scalar((yyvsp[-5].opval)), (yyvsp[-1].opval)), @@ -479,14 +480,14 @@ case 2: break; case 90: -#line 456 "perly.y" +#line 457 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, scalar((yyvsp[-2].opval)), newUNOP(OP_METHOD, 0, (yyvsp[0].opval)))); ;} break; case 91: -#line 460 "perly.y" +#line 461 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, (yyvsp[-1].opval), (yyvsp[0].opval)), @@ -494,7 +495,7 @@ case 2: break; case 92: -#line 465 "perly.y" +#line 466 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, (yyvsp[-3].opval), (yyvsp[-1].opval)), @@ -502,61 +503,61 @@ case 2: break; case 93: -#line 470 "perly.y" +#line 471 "perly.y" { (yyval.opval) = convert((yyvsp[-1].ival), 0, (yyvsp[0].opval)); ;} break; case 94: -#line 472 "perly.y" +#line 473 "perly.y" { (yyval.opval) = convert((yyvsp[-3].ival), 0, (yyvsp[-1].opval)); ;} break; case 95: -#line 474 "perly.y" +#line 475 "perly.y" { SvREFCNT_inc(PL_compcv); (yyvsp[0].opval) = newANONATTRSUB((yyvsp[-1].ival), 0, Nullop, (yyvsp[0].opval)); ;} break; case 96: -#line 477 "perly.y" +#line 478 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, (yyvsp[-2].opval), (yyvsp[0].opval)), (yyvsp[-4].opval))); ;} break; case 99: -#line 491 "perly.y" +#line 492 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (yyvsp[-4].opval), scalar((yyvsp[-2].opval))); PL_expect = XOPERATOR; ;} break; case 100: -#line 494 "perly.y" +#line 495 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((yyvsp[-3].opval)), scalar((yyvsp[-1].opval))); ;} break; case 101: -#line 496 "perly.y" +#line 497 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((yyvsp[-4].opval)),OP_RV2AV), scalar((yyvsp[-1].opval)));;} break; case 102: -#line 500 "perly.y" +#line 501 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((yyvsp[-3].opval)),OP_RV2AV), scalar((yyvsp[-1].opval)));;} break; case 103: -#line 504 "perly.y" +#line 505 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((yyvsp[-4].opval)), jmaybe((yyvsp[-2].opval))); PL_expect = XOPERATOR; ;} break; case 104: -#line 507 "perly.y" +#line 508 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((yyvsp[-5].opval)),OP_RV2HV), jmaybe((yyvsp[-2].opval))); @@ -564,7 +565,7 @@ case 2: break; case 105: -#line 512 "perly.y" +#line 513 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((yyvsp[-4].opval)),OP_RV2HV), jmaybe((yyvsp[-2].opval))); @@ -572,195 +573,195 @@ case 2: break; case 106: -#line 517 "perly.y" +#line 518 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((yyvsp[-3].opval)))); ;} break; case 107: -#line 520 "perly.y" +#line 521 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[-1].opval), newCVREF(0, scalar((yyvsp[-4].opval))))); ;} break; case 108: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[-1].opval), newCVREF(0, scalar((yyvsp[-3].opval))))); ;} break; case 109: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((yyvsp[-2].opval)))); ;} break; case 110: -#line 532 "perly.y" +#line 533 "perly.y" { (yyval.opval) = newSLICEOP(0, (yyvsp[-1].opval), (yyvsp[-4].opval)); ;} break; case 111: -#line 534 "perly.y" +#line 535 "perly.y" { (yyval.opval) = newSLICEOP(0, (yyvsp[-1].opval), Nullop); ;} break; case 112: -#line 539 "perly.y" +#line 540 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (yyvsp[-2].opval), (yyvsp[-1].ival), (yyvsp[0].opval)); ;} break; case 113: -#line 541 "perly.y" +#line 542 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 114: -#line 543 "perly.y" +#line 544 "perly.y" { if ((yyvsp[-1].ival) != OP_REPEAT) scalar((yyvsp[-2].opval)); (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, (yyvsp[-2].opval), scalar((yyvsp[0].opval))); ;} break; case 115: -#line 547 "perly.y" +#line 548 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 116: -#line 549 "perly.y" +#line 550 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 117: -#line 551 "perly.y" +#line 552 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 118: -#line 553 "perly.y" +#line 554 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 119: -#line 555 "perly.y" +#line 556 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 120: -#line 557 "perly.y" +#line 558 "perly.y" { (yyval.opval) = newBINOP((yyvsp[-1].ival), 0, scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval))); ;} break; case 121: -#line 559 "perly.y" +#line 560 "perly.y" { (yyval.opval) = newRANGE((yyvsp[-1].ival), scalar((yyvsp[-2].opval)), scalar((yyvsp[0].opval)));;} break; case 122: -#line 561 "perly.y" +#line 562 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 123: -#line 563 "perly.y" +#line 564 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 124: -#line 565 "perly.y" +#line 566 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 125: -#line 567 "perly.y" +#line 568 "perly.y" { (yyval.opval) = bind_match((yyvsp[-1].ival), (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 126: -#line 572 "perly.y" +#line 573 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((yyvsp[0].opval))); ;} break; case 127: -#line 574 "perly.y" +#line 575 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 128: -#line 576 "perly.y" +#line 577 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((yyvsp[0].opval))); ;} break; case 129: -#line 578 "perly.y" +#line 579 "perly.y" { (yyval.opval) = newUNOP(OP_COMPLEMENT, 0, scalar((yyvsp[0].opval)));;} break; case 130: -#line 580 "perly.y" +#line 581 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, mod(scalar((yyvsp[-1].opval)), OP_POSTINC)); ;} break; case 131: -#line 583 "perly.y" +#line 584 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, mod(scalar((yyvsp[-1].opval)), OP_POSTDEC)); ;} break; case 132: -#line 586 "perly.y" +#line 587 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, mod(scalar((yyvsp[0].opval)), OP_PREINC)); ;} break; case 133: -#line 589 "perly.y" +#line 590 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, mod(scalar((yyvsp[0].opval)), OP_PREDEC)); ;} break; case 134: -#line 596 "perly.y" +#line 597 "perly.y" { (yyval.opval) = newANONLIST((yyvsp[-1].opval)); ;} break; case 135: -#line 598 "perly.y" +#line 599 "perly.y" { (yyval.opval) = newANONLIST(Nullop); ;} break; case 136: -#line 600 "perly.y" +#line 601 "perly.y" { (yyval.opval) = newANONHASH((yyvsp[-2].opval)); ;} break; case 137: -#line 602 "perly.y" +#line 603 "perly.y" { (yyval.opval) = newANONHASH(Nullop); ;} break; case 138: -#line 604 "perly.y" +#line 605 "perly.y" { SvREFCNT_inc(PL_compcv); (yyval.opval) = newANONATTRSUB((yyvsp[-3].ival), (yyvsp[-2].opval), (yyvsp[-1].opval), (yyvsp[0].opval)); ;} break; case 139: -#line 611 "perly.y" +#line 612 "perly.y" { (yyval.opval) = dofile((yyvsp[0].opval), (yyvsp[-1].ival)); ;} break; case 140: -#line 613 "perly.y" +#line 614 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, scope((yyvsp[0].opval))); ;} break; case 141: -#line 615 "perly.y" +#line 616 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -771,7 +772,7 @@ case 2: break; case 142: -#line 623 "perly.y" +#line 624 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -783,14 +784,14 @@ case 2: break; case 143: -#line 632 "perly.y" +#line 633 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar((yyvsp[-2].opval)))), Nullop)); dep();;} break; case 144: -#line 636 "perly.y" +#line 637 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, (yyvsp[-1].opval), @@ -798,67 +799,67 @@ case 2: break; case 149: -#line 648 "perly.y" +#line 649 "perly.y" { (yyval.opval) = newCONDOP(0, (yyvsp[-4].opval), (yyvsp[-2].opval), (yyvsp[0].opval)); ;} break; case 150: -#line 650 "perly.y" +#line 651 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, mod((yyvsp[0].opval),OP_REFGEN)); ;} break; case 151: -#line 652 "perly.y" +#line 653 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 152: -#line 654 "perly.y" +#line 655 "perly.y" { (yyval.opval) = localize((yyvsp[0].opval),(yyvsp[-1].ival)); ;} break; case 153: -#line 656 "perly.y" +#line 657 "perly.y" { (yyval.opval) = sawparens((yyvsp[-1].opval)); ;} break; case 154: -#line 658 "perly.y" +#line 659 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); ;} break; case 155: -#line 660 "perly.y" +#line 661 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 156: -#line 662 "perly.y" +#line 663 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 157: -#line 664 "perly.y" +#line 665 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 158: -#line 666 "perly.y" +#line 667 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 159: -#line 668 "perly.y" +#line 669 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((yyvsp[0].opval), OP_AV2ARYLEN));;} break; case 160: -#line 670 "perly.y" +#line 671 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 161: -#line 672 "perly.y" +#line 673 "perly.y" { (yyval.opval) = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -867,7 +868,7 @@ case 2: break; case 162: -#line 678 "perly.y" +#line 679 "perly.y" { (yyval.opval) = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -877,223 +878,223 @@ case 2: break; case 163: -#line 685 "perly.y" +#line 686 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 164: -#line 687 "perly.y" +#line 688 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((yyvsp[0].opval))); ;} break; case 165: -#line 689 "perly.y" +#line 690 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((yyvsp[-2].opval))); ;} break; case 166: -#line 691 "perly.y" +#line 692 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[-1].opval), scalar((yyvsp[-3].opval)))); ;} break; case 167: -#line 694 "perly.y" +#line 695 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[0].opval), scalar((yyvsp[-1].opval)))); ;} break; case 168: -#line 697 "perly.y" +#line 698 "perly.y" { (yyval.opval) = newOP((yyvsp[0].ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; ;} break; case 169: -#line 700 "perly.y" +#line 701 "perly.y" { (yyval.opval) = newLOOPEX((yyvsp[-1].ival),(yyvsp[0].opval)); ;} break; case 170: -#line 702 "perly.y" +#line 703 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((yyvsp[0].opval))); ;} break; case 171: -#line 704 "perly.y" +#line 705 "perly.y" { (yyval.opval) = newOP((yyvsp[0].ival), 0); ;} break; case 172: -#line 706 "perly.y" +#line 707 "perly.y" { (yyval.opval) = newUNOP((yyvsp[-1].ival), 0, (yyvsp[0].opval)); ;} break; case 173: -#line 708 "perly.y" +#line 709 "perly.y" { (yyval.opval) = newUNOP((yyvsp[-1].ival), 0, (yyvsp[0].opval)); ;} break; case 174: -#line 710 "perly.y" +#line 711 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (yyvsp[0].ival) ? OPf_SPECIAL : 0); ;} break; case 175: -#line 712 "perly.y" +#line 713 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (yyvsp[-1].ival) ? OPf_SPECIAL : 0, (yyvsp[0].opval)); ;} break; case 176: -#line 714 "perly.y" +#line 715 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, (yyvsp[0].opval), scalar((yyvsp[-1].opval)))); ;} break; case 177: -#line 717 "perly.y" +#line 718 "perly.y" { (yyval.opval) = newOP((yyvsp[0].ival), 0); ;} break; case 178: -#line 719 "perly.y" +#line 720 "perly.y" { (yyval.opval) = newOP((yyvsp[-2].ival), 0); ;} break; case 179: -#line 721 "perly.y" +#line 722 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((yyvsp[0].opval))); ;} break; case 180: -#line 724 "perly.y" +#line 725 "perly.y" { (yyval.opval) = (yyvsp[-2].ival) == OP_NOT ? newUNOP((yyvsp[-2].ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((yyvsp[-2].ival), OPf_SPECIAL); ;} break; case 181: -#line 727 "perly.y" +#line 728 "perly.y" { (yyval.opval) = newUNOP((yyvsp[-3].ival), 0, (yyvsp[-1].opval)); ;} break; case 182: -#line 729 "perly.y" +#line 730 "perly.y" { (yyval.opval) = pmruntime((yyvsp[-3].opval), (yyvsp[-1].opval), 1); ;} break; case 185: -#line 736 "perly.y" +#line 737 "perly.y" { (yyval.opval) = my_attrs((yyvsp[-1].opval),(yyvsp[0].opval)); ;} break; case 186: -#line 738 "perly.y" +#line 739 "perly.y" { (yyval.opval) = localize((yyvsp[0].opval),(yyvsp[-1].ival)); ;} break; case 187: -#line 743 "perly.y" +#line 744 "perly.y" { (yyval.opval) = sawparens((yyvsp[-1].opval)); ;} break; case 188: -#line 745 "perly.y" +#line 746 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); ;} break; case 189: -#line 747 "perly.y" +#line 748 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 190: -#line 749 "perly.y" +#line 750 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 191: -#line 751 "perly.y" +#line 752 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 192: -#line 756 "perly.y" +#line 757 "perly.y" { (yyval.opval) = Nullop; ;} break; case 193: -#line 758 "perly.y" +#line 759 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 194: -#line 762 "perly.y" +#line 763 "perly.y" { (yyval.opval) = Nullop; ;} break; case 195: -#line 764 "perly.y" +#line 765 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; case 196: -#line 766 "perly.y" +#line 767 "perly.y" { (yyval.opval) = (yyvsp[-1].opval); ;} break; case 197: -#line 772 "perly.y" +#line 773 "perly.y" { PL_in_my = 0; (yyval.opval) = my((yyvsp[0].opval)); ;} break; case 198: -#line 776 "perly.y" +#line 777 "perly.y" { (yyval.opval) = newCVREF((yyvsp[-1].ival),(yyvsp[0].opval)); ;} break; case 199: -#line 780 "perly.y" +#line 781 "perly.y" { (yyval.opval) = newSVREF((yyvsp[0].opval)); ;} break; case 200: -#line 784 "perly.y" +#line 785 "perly.y" { (yyval.opval) = newAVREF((yyvsp[0].opval)); ;} break; case 201: -#line 788 "perly.y" +#line 789 "perly.y" { (yyval.opval) = newHVREF((yyvsp[0].opval)); ;} break; case 202: -#line 792 "perly.y" +#line 793 "perly.y" { (yyval.opval) = newAVREF((yyvsp[0].opval)); ;} break; case 203: -#line 796 "perly.y" +#line 797 "perly.y" { (yyval.opval) = newGVREF(0,(yyvsp[0].opval)); ;} break; case 204: -#line 801 "perly.y" +#line 802 "perly.y" { (yyval.opval) = scalar((yyvsp[0].opval)); ;} break; case 205: -#line 803 "perly.y" +#line 804 "perly.y" { (yyval.opval) = scalar((yyvsp[0].opval)); ;} break; case 206: -#line 805 "perly.y" +#line 806 "perly.y" { (yyval.opval) = scope((yyvsp[0].opval)); ;} break; case 207: -#line 808 "perly.y" +#line 809 "perly.y" { (yyval.opval) = (yyvsp[0].opval); ;} break; diff --git a/perly.tab b/perly.tab index d1807d7..5e84c72 100644 --- a/perly.tab +++ b/perly.tab @@ -171,21 +171,21 @@ static const unsigned short int yyrline[] = 212, 219, 222, 228, 229, 234, 240, 246, 249, 253, 256, 273, 280, 290, 296, 297, 302, 303, 307, 312, 316, 320, 326, 327, 331, 333, 335, 337, 339, 343, - 348, 349, 353, 359, 365, 370, 375, 380, 389, 390, - 395, 396, 398, 403, 405, 410, 411, 414, 419, 418, - 426, 428, 430, 432, 436, 438, 440, 444, 447, 450, - 455, 459, 464, 469, 471, 474, 473, 483, 484, 488, - 493, 495, 499, 503, 506, 511, 516, 519, 524, 528, - 531, 533, 538, 540, 542, 546, 548, 550, 552, 554, - 556, 558, 560, 562, 564, 566, 571, 573, 575, 577, - 579, 582, 585, 588, 595, 597, 599, 601, 603, 610, - 612, 614, 622, 631, 635, 643, 644, 645, 646, 647, - 649, 651, 653, 655, 657, 659, 661, 663, 665, 667, - 669, 671, 677, 684, 686, 688, 690, 693, 696, 699, - 701, 703, 705, 707, 709, 711, 713, 716, 718, 720, - 723, 726, 728, 730, 731, 735, 737, 742, 744, 746, - 748, 750, 755, 757, 762, 763, 765, 771, 775, 779, - 783, 787, 791, 795, 800, 802, 804, 807 + 348, 349, 353, 359, 365, 370, 375, 380, 390, 391, + 396, 397, 399, 404, 406, 411, 412, 415, 420, 419, + 427, 429, 431, 433, 437, 439, 441, 445, 448, 451, + 456, 460, 465, 470, 472, 475, 474, 484, 485, 489, + 494, 496, 500, 504, 507, 512, 517, 520, 525, 529, + 532, 534, 539, 541, 543, 547, 549, 551, 553, 555, + 557, 559, 561, 563, 565, 567, 572, 574, 576, 578, + 580, 583, 586, 589, 596, 598, 600, 602, 604, 611, + 613, 615, 623, 632, 636, 644, 645, 646, 647, 648, + 650, 652, 654, 656, 658, 660, 662, 664, 666, 668, + 670, 672, 678, 685, 687, 689, 691, 694, 697, 700, + 702, 704, 706, 708, 710, 712, 714, 717, 719, 721, + 724, 727, 729, 731, 732, 736, 738, 743, 745, 747, + 749, 751, 756, 758, 763, 764, 766, 772, 776, 780, + 784, 788, 792, 796, 801, 803, 805, 808 }; #endif diff --git a/perly.y b/perly.y index 0ae38d5..99493ce 100644 --- a/perly.y +++ b/perly.y @@ -379,7 +379,8 @@ startformsub: /* NULL */ /* start a format subroutine scope */ /* Name of a subroutine - must be a bareword, could be special */ subname : WORD { const char *const name = SvPV_nolen_const(((SVOP*)$1)->op_sv); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT") || strEQ(name, "CHECK")) + || strEQ(name, "INIT") || strEQ(name, "CHECK") + || strEQ(name, "UNITCHECK")) CvSPECIAL_on(PL_compcv); $$ = $1; } ; diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 2e21941..390eb96 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -956,12 +956,12 @@ for incredibly long examples of these. =head2 Debugging compile-time statements If you have compile-time executable statements (such as code within -BEGIN and CHECK blocks or C statements), these will I be -stopped by debugger, although Cs and INIT blocks will, and -compile-time statements can be traced with C option set -in C). From your own Perl code, however, you can -transfer control back to the debugger using the following statement, -which is harmless if the debugger is not running: +BEGIN, UNITCHECK and CHECK blocks or C statements), these will +I be stopped by debugger, although Cs and INIT blocks +will, and compile-time statements can be traced with C +option set in C). From your own Perl code, however, you +can transfer control back to the debugger using the following +statement, which is harmless if the debugger is not running: $DB::single = 1; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index d5e44c7..59a9748 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1641,9 +1641,9 @@ Check the #! line, or manually feed your script into Perl yourself. =item %s failed--call queue aborted -(F) An untrapped exception was raised while executing a CHECK, INIT, or -END subroutine. Processing of the remainder of the queue of such -routines has been prematurely ended. +(F) An untrapped exception was raised while executing a UNITCHECK, +CHECK, INIT, or END subroutine. Processing of the remainder of the +queue of such routines has been prematurely ended. =item False [] range "%s" in regex; marked by <-- HERE in m/%s/ diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index cda8f56..63d7399 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -5007,8 +5007,8 @@ array by 1 and moving everything down. If there are no elements in the array, returns the undefined value. If ARRAY is omitted, shifts the C<@_> array within the lexical scope of subroutines and formats, and the C<@ARGV> array outside of a subroutine and also within the lexical scopes -established by the C, C, C, C -and C constructs. +established by the C, C, C, C, +C and C constructs. See also C, C, and C. C and C do the same thing to the left end of an array that C and C do to the @@ -7238,8 +7238,8 @@ looking for no value (void context). return wantarray ? @a : "@a"; C's result is unspecified in the top level of a file, -in a C, C, C or C block, or in a C -method. +in a C, C, C, C or C block, or +in a C method. This function should have been named wantlist() instead. diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 5134609..240630c 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -258,12 +258,12 @@ rather than: This also has implications for the use of the SUPER:: qualifier (see L). -=head2 BEGIN, CHECK, INIT and END -X X X X +=head2 BEGIN, UNITCHECK, CHECK, INIT and END +X X X X X -Four specially named code blocks are executed at the beginning and at the end -of a running Perl program. These are the C, C, C, and -C blocks. +Five specially named code blocks are executed at the beginning and at +the end of a running Perl program. These are the C, +C, C, C, and C blocks. These code blocks can be prefixed with C to give the appearance of a subroutine (although this is not considered good style). One should note @@ -282,9 +282,10 @@ and such from other files in time to be visible to the rest of the compile and run time. Once a C has run, it is immediately undefined and any code it used is returned to Perl's memory pool. -It should be noted that C code blocks B executed inside string -C's. The C and C code blocks are B executed inside -a string eval, which e.g. can be a problem in a mod_perl environment. +It should be noted that C and C code blocks B +executed inside string C's. The C and C code +blocks are B executed inside a string eval, which e.g. can be a +problem in a mod_perl environment. An C code block is executed as late as possible, that is, after perl has finished running the program and just before the interpreter @@ -307,8 +308,15 @@ value of the program. Beware of changing C<$?> by accident (e.g. by running something via C). X<$?> -C and C code blocks are useful to catch the transition between -the compilation phase and the execution phase of the main program. +C, C and C code blocks are useful to catch the +transition between the compilation phase and the execution phase of +the main program. + +C blocks are run just after the unit which defined them has +been compiled. The main program file and each module it loads are +compilation units, as are string Cs, code compiled using the +C<(?{ })> construct in a regex, calls to C, C, +and code after the C<-e> switch on the command line. C code blocks are run just after the B Perl compile phase ends and before the run time begins, in LIFO order. C code blocks are used @@ -331,26 +339,32 @@ The B program makes it all clear, eventually: # begincheck - print " 8. Ordinary code runs at runtime.\n"; + print "10. Ordinary code runs at runtime.\n"; - END { print "14. So this is the end of the tale.\n" } - INIT { print " 5. INIT blocks run FIFO just before runtime.\n" } - CHECK { print " 4. So this is the fourth line.\n" } + END { print "16. So this is the end of the tale.\n" } + INIT { print " 7. INIT blocks run FIFO just before runtime.\n" } + UNITCHECK { + print " 4. And therefore before any CHECK blocks.\n" + } + CHECK { print " 6. So this is the sixth line.\n" } - print " 9. It runs in order, of course.\n"; + print "11. It runs in order, of course.\n"; BEGIN { print " 1. BEGIN blocks run FIFO during compilation.\n" } - END { print "13. Read perlmod for the rest of the story.\n" } - CHECK { print " 3. CHECK blocks run LIFO at compilation's end.\n" } - INIT { print " 6. Run this again, using Perl's -c switch.\n" } + END { print "15. Read perlmod for the rest of the story.\n" } + CHECK { print " 5. CHECK blocks run LIFO after all compilation.\n" } + INIT { print " 8. Run this again, using Perl's -c switch.\n" } - print "10. This is anti-obfuscated code.\n"; + print "12. This is anti-obfuscated code.\n"; - END { print "12. END blocks run LIFO at quitting time.\n" } + END { print "14. END blocks run LIFO at quitting time.\n" } BEGIN { print " 2. So this line comes out second.\n" } - INIT { print " 7. You'll see the difference right away.\n" } + UNITCHECK { + print " 3. UNITCHECK blocks run LIFO after each file is compiled.\n" + } + INIT { print " 9. You'll see the difference right away.\n" } - print "11. It merely _looks_ like it should be confusing.\n"; + print "13. It merely _looks_ like it should be confusing.\n"; __END__ diff --git a/pod/perlrun.pod b/pod/perlrun.pod index a0115bc..6ac810a 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -360,10 +360,10 @@ switch was therefore "recycled".) X<-c> causes Perl to check the syntax of the program and then exit without -executing it. Actually, it I execute C, C, and -C blocks, because these are considered as occurring outside the -execution of your program. C and C blocks, however, will -be skipped. +executing it. Actually, it I execute C, C, +C, and C blocks, because these are considered as occurring +outside the execution of your program. C and C blocks, +however, will be skipped. =item B<-d> X<-d> X<-dt> diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 083b9a8..f11f1ae 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -227,10 +227,10 @@ indirectly by the run-time system itself, usually due to a triggered event. Subroutines that do special, pre-defined things include C, C, C plus all functions mentioned in L and L. -The C, C, C and C subroutines are not so much -subroutines as named special code blocks, of which you can have more -than one in a package, and which you can B call explicitly. See -L +The C, C, C, C and C subroutines +are not so much subroutines as named special code blocks, of which you +can have more than one in a package, and which you can B call +explicitly. See L =head2 Private Variables via my() X X X X X @@ -521,8 +521,9 @@ starts to run: } } -See L about the -special triggered code blocks, C, C, C and C. +See L about the +special triggered code blocks, C, C, C, +C and C. If declared at the outermost scope (the file scope), then lexicals work somewhat like C's file statics. They are available to all diff --git a/pp_ctl.c b/pp_ctl.c index cda9811..8b1159e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2914,9 +2914,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) SAVESPTR(PL_curstash); PL_curstash = CopSTASH(PL_curcop); } + /* XXX:ajgo do we really need to alloc an AV for begin/checkunit */ SAVESPTR(PL_beginav); PL_beginav = newAV(); SAVEFREESV(PL_beginav); + SAVESPTR(PL_unitcheckav); + PL_unitcheckav = newAV(); + SAVEFREESV(PL_unitcheckav); SAVEI32(PL_error_count); #ifdef PERL_MAD @@ -3010,6 +3014,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) } } + if (PL_unitcheckav) + call_list(PL_scopestack_ix, PL_unitcheckav); + /* compiled okay, so do it */ CvDEPTH(PL_compcv) = 1; diff --git a/sv.c b/sv.c index 8820f2a..2a92ba3 100644 --- a/sv.c +++ b/sv.c @@ -11073,6 +11073,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_beginav = av_dup_inc(proto_perl->Ibeginav, param); PL_beginav_save = av_dup_inc(proto_perl->Ibeginav_save, param); PL_checkav_save = av_dup_inc(proto_perl->Icheckav_save, param); + PL_unitcheckav = av_dup_inc(proto_perl->Iunitcheckav, param); + PL_unitcheckav_save = av_dup_inc(proto_perl->Iunitcheckav_save, param); PL_endav = av_dup_inc(proto_perl->Iendav, param); PL_checkav = av_dup_inc(proto_perl->Icheckav, param); PL_initav = av_dup_inc(proto_perl->Iinitav, param); diff --git a/t/op/blocks.t b/t/op/blocks.t new file mode 100644 index 0000000..476d9ea --- /dev/null +++ b/t/op/blocks.t @@ -0,0 +1,107 @@ +#!./perl + +BEGIN { + chdir 't'; + @INC = '../lib'; + require './test.pl'; +} + +plan tests => 3; + +my @expect = qw( +b1 +b2 +b3 +b4 +b6 +u5 +b7 +u6 +u1 +c3 +c2 +c1 +i1 +i2 +b5 +u2 +u3 +u4 +e2 +e1 + ); +my $expect = ":" . join(":", @expect); + +fresh_perl_is(<<'SCRIPT', $expect,{switches => [''], stdin => '', stderr => 1 },'Order of execution of special blocks'); +BEGIN {print ":b1"} +END {print ":e1"} +BEGIN {print ":b2"} +{ + BEGIN {BEGIN {print ":b3"}; print ":b4"} +} +CHECK {print ":c1"} +INIT {print ":i1"} +UNITCHECK {print ":u1"} +eval 'BEGIN {print ":b5"}'; +eval 'UNITCHECK {print ":u2"}'; +eval 'UNITCHECK {print ":u3"; UNITCHECK {print ":u4"}}'; +"a" =~ /(?{UNITCHECK {print ":u5"}; + CHECK {print ":c2"}; + BEGIN {print ":b6"}})/x; +eval {BEGIN {print ":b7"}}; +eval {UNITCHECK {print ":u6"}}; +eval {INIT {print ":i2"}}; +eval {CHECK {print ":c3"}}; +END {print ":e2"} +SCRIPT + +@expect =( +# BEGIN +qw( main bar myfoo foo ), +# UNITCHECK +qw( foo myfoo bar main ), +# CHECK +qw( foo myfoo bar main ), +# INIT +qw( main bar myfoo foo ), +# END +qw(foo myfoo bar main )); + +$expect = ":" . join(":", @expect); +fresh_perl_is(<<'SCRIPT2', $expect,{switches => [''], stdin => '', stderr => 1 },'blocks interact with packages/scopes'); +BEGIN {$f = 'main'; print ":$f"} +UNITCHECK {print ":$f"} +CHECK {print ":$f"} +INIT {print ":$f"} +END {print ":$f"} +package bar; +BEGIN {$f = 'bar';print ":$f"} +UNITCHECK {print ":$f"} +CHECK {print ":$f"} +INIT {print ":$f"} +END {print ":$f"} +package foo; +{ + my $f; + BEGIN {$f = 'myfoo'; print ":$f"} + UNITCHECK {print ":$f"} + CHECK {print ":$f"} + INIT {print ":$f"} + END {print ":$f"} +} +BEGIN {$f = "foo";print ":$f"} +UNITCHECK {print ":$f"} +CHECK {print ":$f"} +INIT {print ":$f"} +END {print ":$f"} +SCRIPT2 + +@expect = qw(begin unitcheck check init end); +$expect = ":" . join(":", @expect); +fresh_perl_is(<<'SCRIPT3', $expect,{switches => [''], stdin => '', stderr => 1 },'can name blocks as sub FOO'); +sub BEGIN {print ":begin"} +sub UNITCHECK {print ":unitcheck"} +sub CHECK {print ":check"} +sub INIT {print ":init"} +sub END {print ":end"} +SCRIPT3 diff --git a/toke.c b/toke.c index 4158e32..e3efd8f 100644 --- a/toke.c +++ b/toke.c @@ -5630,6 +5630,7 @@ Perl_yylex(pTHX) case KEY_AUTOLOAD: case KEY_DESTROY: case KEY_BEGIN: + case KEY_UNITCHECK: case KEY_CHECK: case KEY_INIT: case KEY_END: @@ -9683,9 +9684,24 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) goto unknown; } - case 9: /* 8 tokens of length 9 */ + case 9: /* 9 tokens of length 9 */ switch (name[0]) { + case 'U': + if (name[1] == 'N' && + name[2] == 'I' && + name[3] == 'T' && + name[4] == 'C' && + name[5] == 'H' && + name[6] == 'E' && + name[7] == 'C' && + name[8] == 'K') + { /* UNITCHECK */ + return KEY_UNITCHECK; + } + + goto unknown; + case 'e': if (name[1] == 'n' && name[2] == 'd' &&