Pseudo-hashes. Optional strong typing. RESTART {}.
p4raw-id: //depot/perl@2
else
(void)av_store(av,fill,&sv_undef);
}
+
+SV**
+avhv_fetch(av, key, klen, lval)
+AV *av;
+char *key;
+U32 klen;
+I32 lval;
+{
+ SV **keys, **indsvp;
+ I32 ind;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE);
+ if (indsvp) {
+ ind = SvIV(*indsvp);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ } else {
+ if (!lval)
+ return 0;
+
+ ind = AvFILL(av) + 1;
+ hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), 0);
+ }
+ return av_fetch(av, ind, lval);
+}
+
+SV**
+avhv_store(av, key, klen, val, hash)
+AV *av;
+char *key;
+U32 klen;
+SV *val;
+U32 hash;
+{
+ SV **keys, **indsvp;
+ I32 ind;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE);
+ if (indsvp) {
+ ind = SvIV(*indsvp);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ } else {
+ ind = AvFILL(av) + 1;
+ hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), hash);
+ }
+ return av_store(av, ind, val);
+}
+
+bool
+avhv_exists(av, key, klen)
+AV *av;
+char *key;
+U32 klen;
+{
+ SV **keys;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ return hv_exists((HV*)SvRV(*keys), key, klen);
+}
+
+/* avhv_delete leaks. Caller can re-index and compress if so desired. */
+SV *
+avhv_delete(av, key, klen, flags)
+AV *av;
+char *key;
+U32 klen;
+I32 flags;
+{
+ SV **keys;
+ SV *sv;
+ SV **svp;
+ I32 ind;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ sv = hv_delete((HV*)SvRV(*keys), key, klen, 0);
+ if (!sv)
+ return Nullsv;
+ ind = SvIV(sv);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ svp = av_fetch(av, ind, FALSE);
+ if (!svp)
+ return Nullsv;
+ if (flags & G_DISCARD) {
+ sv = Nullsv;
+ SvREFCNT_dec(*svp);
+ } else {
+ sv = sv_2mortal(*svp);
+ }
+ *svp = &sv_undef;
+ return sv;
+}
+
+I32
+avhv_iterinit(av)
+AV *av;
+{
+ SV **keys;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ return hv_iterinit((HV*)SvRV(*keys));
+}
+
+HE *
+avhv_iternext(av)
+AV *av;
+{
+ SV **keys;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ return hv_iternext((HV*)SvRV(*keys));
+}
+
+SV *
+avhv_iterval(av, entry)
+AV *av;
+register HE *entry;
+{
+ SV **keys;
+ SV *sv;
+ I32 ind;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ sv = hv_iterval((HV*)SvRV(*keys), entry);
+ ind = SvIV(sv);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ return *av_fetch(av, ind, TRUE);
+}
+
+SV *
+avhv_iternextsv(av, key, retlen)
+AV *av;
+char **key;
+I32 *retlen;
+{
+ SV **keys;
+ HE *he;
+ SV *sv;
+ I32 ind;
+
+ keys = av_fetch(av, 0, FALSE);
+ if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
+ croak("Can't coerce array into hash");
+ if ( (he = hv_iternext((HV*)SvRV(*keys))) == NULL)
+ return NULL;
+ *key = hv_iterkey(he, retlen);
+ sv = hv_iterval((HV*)SvRV(*keys), he);
+ ind = SvIV(sv);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ return *av_fetch(av, ind, TRUE);
+}
SV *tmpstr;
I32 dokeys = (op->op_type == OP_KEYS);
I32 dovalues = (op->op_type == OP_VALUES);
-
+ I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+
if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
dokeys = dovalues = TRUE;
if (!hv)
RETURN;
- (void)hv_iterinit(hv); /* always reset iterator regardless */
-
+ if (realhv)
+ (void)hv_iterinit(hv); /* always reset iterator regardless */
+ else
+ (void)avhv_iterinit((AV*)hv);
+
if (GIMME != G_ARRAY) {
dTARGET;
else {
i = 0;
/*SUPPRESS 560*/
- while (entry = hv_iternext(hv)) {
+ while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
i++;
}
}
EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
- while (entry = hv_iternext(hv)) {
+ while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
SPAGAIN;
if (dokeys) {
tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */
if (dovalues) {
tmpstr = NEWSV(45,0);
PUTBACK;
- sv_setsv(tmpstr,hv_iterval(hv,entry));
+ sv_setsv(tmpstr,realhv ?
+ hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
SPAGAIN;
DEBUG_H( {
sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
}
return NORMAL;
}
-
#define hexdigit Perl_hexdigit
#define hints Perl_hints
#define in_my Perl_in_my
+#define in_my_stash Perl_in_my_stash
#define inc_amg Perl_inc_amg
#define io_close Perl_io_close
#define know_next Perl_know_next
#define regeol Perl_regeol
#define regfold Perl_regfold
#define reginput Perl_reginput
-#define regkind Perl_regkind
+#define regkind Perl_regkind
#define reglastparen Perl_reglastparen
#define regmyendp Perl_regmyendp
#define regmyp_size Perl_regmyp_size
#define append_list Perl_append_list
#define apply Perl_apply
#define assertref Perl_assertref
+#define avhv_delete Perl_avhv_delete
+#define avhv_exists Perl_avhv_exists
+#define avhv_fetch Perl_avhv_fetch
+#define avhv_iterinit Perl_avhv_iterinit
+#define avhv_iternext Perl_avhv_iternext
+#define avhv_iternextsv Perl_avhv_iternextsv
+#define avhv_iterval Perl_avhv_iterval
+#define avhv_store Perl_avhv_store
#define av_clear Perl_av_clear
#define av_extend Perl_av_extend
#define av_fake Perl_av_fake
#define preambled (curinterp->Ipreambled)
#define preambleav (curinterp->Ipreambleav)
#define preprocess (curinterp->Ipreprocess)
+#define restartav (curinterp->Irestartav)
#define restartop (curinterp->Irestartop)
#define rightgv (curinterp->Irightgv)
#define rs (curinterp->Irs)
#define Ipreambled preambled
#define Ipreambleav preambleav
#define Ipreprocess preprocess
+#define Irestartav restartav
#define Irestartop restartop
#define Irightgv rightgv
#define Irs rs
RETVAL
BOOT:
- newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
+ newXS("DB_File::TIEARRAY", XS_DB_File_TIEHASH, file);
int
db_DESTROY(db)
hexdigit
hints
in_my
+in_my_stash
inc_amg
io_close
know_next
append_list
apply
assertref
+avhv_delete
+avhv_exists
+avhv_fetch
+avhv_iterinit
+avhv_iternext
+avhv_iternextsv
+avhv_iterval
+avhv_store
av_clear
av_extend
av_fake
preambled
preambleav
preprocess
+restartav
restartop
rightgv
rs
#define KEY_LE 13
#define KEY_LT 14
#define KEY_NE 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_caller 24
-#define KEY_chdir 25
-#define KEY_chmod 26
-#define KEY_chomp 27
-#define KEY_chop 28
-#define KEY_chown 29
-#define KEY_chr 30
-#define KEY_chroot 31
-#define KEY_close 32
-#define KEY_closedir 33
-#define KEY_cmp 34
-#define KEY_connect 35
-#define KEY_continue 36
-#define KEY_cos 37
-#define KEY_crypt 38
-#define KEY_dbmclose 39
-#define KEY_dbmopen 40
-#define KEY_defined 41
-#define KEY_delete 42
-#define KEY_die 43
-#define KEY_do 44
-#define KEY_dump 45
-#define KEY_each 46
-#define KEY_else 47
-#define KEY_elsif 48
-#define KEY_endgrent 49
-#define KEY_endhostent 50
-#define KEY_endnetent 51
-#define KEY_endprotoent 52
-#define KEY_endpwent 53
-#define KEY_endservent 54
-#define KEY_eof 55
-#define KEY_eq 56
-#define KEY_eval 57
-#define KEY_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_glob 97
-#define KEY_gmtime 98
-#define KEY_goto 99
-#define KEY_grep 100
-#define KEY_gt 101
-#define KEY_hex 102
-#define KEY_if 103
-#define KEY_index 104
-#define KEY_int 105
-#define KEY_ioctl 106
-#define KEY_join 107
-#define KEY_keys 108
-#define KEY_kill 109
-#define KEY_last 110
-#define KEY_lc 111
-#define KEY_lcfirst 112
-#define KEY_le 113
-#define KEY_length 114
-#define KEY_link 115
-#define KEY_listen 116
-#define KEY_local 117
-#define KEY_localtime 118
-#define KEY_log 119
-#define KEY_lstat 120
-#define KEY_lt 121
-#define KEY_m 122
-#define KEY_map 123
-#define KEY_mkdir 124
-#define KEY_msgctl 125
-#define KEY_msgget 126
-#define KEY_msgrcv 127
-#define KEY_msgsnd 128
-#define KEY_my 129
-#define KEY_ne 130
-#define KEY_next 131
-#define KEY_no 132
-#define KEY_not 133
-#define KEY_oct 134
-#define KEY_open 135
-#define KEY_opendir 136
-#define KEY_or 137
-#define KEY_ord 138
-#define KEY_pack 139
-#define KEY_package 140
-#define KEY_pipe 141
-#define KEY_pop 142
-#define KEY_pos 143
-#define KEY_print 144
-#define KEY_printf 145
-#define KEY_prototype 146
-#define KEY_push 147
-#define KEY_q 148
-#define KEY_qq 149
-#define KEY_quotemeta 150
-#define KEY_qw 151
-#define KEY_qx 152
-#define KEY_rand 153
-#define KEY_read 154
-#define KEY_readdir 155
-#define KEY_readline 156
-#define KEY_readlink 157
-#define KEY_readpipe 158
-#define KEY_recv 159
-#define KEY_redo 160
-#define KEY_ref 161
-#define KEY_rename 162
-#define KEY_require 163
-#define KEY_reset 164
-#define KEY_return 165
-#define KEY_reverse 166
-#define KEY_rewinddir 167
-#define KEY_rindex 168
-#define KEY_rmdir 169
-#define KEY_s 170
-#define KEY_scalar 171
-#define KEY_seek 172
-#define KEY_seekdir 173
-#define KEY_select 174
-#define KEY_semctl 175
-#define KEY_semget 176
-#define KEY_semop 177
-#define KEY_send 178
-#define KEY_setgrent 179
-#define KEY_sethostent 180
-#define KEY_setnetent 181
-#define KEY_setpgrp 182
-#define KEY_setpriority 183
-#define KEY_setprotoent 184
-#define KEY_setpwent 185
-#define KEY_setservent 186
-#define KEY_setsockopt 187
-#define KEY_shift 188
-#define KEY_shmctl 189
-#define KEY_shmget 190
-#define KEY_shmread 191
-#define KEY_shmwrite 192
-#define KEY_shutdown 193
-#define KEY_sin 194
-#define KEY_sleep 195
-#define KEY_socket 196
-#define KEY_socketpair 197
-#define KEY_sort 198
-#define KEY_splice 199
-#define KEY_split 200
-#define KEY_sprintf 201
-#define KEY_sqrt 202
-#define KEY_srand 203
-#define KEY_stat 204
-#define KEY_study 205
-#define KEY_sub 206
-#define KEY_substr 207
-#define KEY_symlink 208
-#define KEY_syscall 209
-#define KEY_sysopen 210
-#define KEY_sysread 211
-#define KEY_system 212
-#define KEY_syswrite 213
-#define KEY_tell 214
-#define KEY_telldir 215
-#define KEY_tie 216
-#define KEY_tied 217
-#define KEY_time 218
-#define KEY_times 219
-#define KEY_tr 220
-#define KEY_truncate 221
-#define KEY_uc 222
-#define KEY_ucfirst 223
-#define KEY_umask 224
-#define KEY_undef 225
-#define KEY_unless 226
-#define KEY_unlink 227
-#define KEY_unpack 228
-#define KEY_unshift 229
-#define KEY_untie 230
-#define KEY_until 231
-#define KEY_use 232
-#define KEY_utime 233
-#define KEY_values 234
-#define KEY_vec 235
-#define KEY_wait 236
-#define KEY_waitpid 237
-#define KEY_wantarray 238
-#define KEY_warn 239
-#define KEY_while 240
-#define KEY_write 241
-#define KEY_x 242
-#define KEY_xor 243
-#define KEY_y 244
+#define KEY_RESTART 16
+#define KEY_abs 17
+#define KEY_accept 18
+#define KEY_alarm 19
+#define KEY_and 20
+#define KEY_atan2 21
+#define KEY_bind 22
+#define KEY_binmode 23
+#define KEY_bless 24
+#define KEY_caller 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_close 33
+#define KEY_closedir 34
+#define KEY_cmp 35
+#define KEY_connect 36
+#define KEY_continue 37
+#define KEY_cos 38
+#define KEY_crypt 39
+#define KEY_dbmclose 40
+#define KEY_dbmopen 41
+#define KEY_defined 42
+#define KEY_delete 43
+#define KEY_die 44
+#define KEY_do 45
+#define KEY_dump 46
+#define KEY_each 47
+#define KEY_else 48
+#define KEY_elsif 49
+#define KEY_endgrent 50
+#define KEY_endhostent 51
+#define KEY_endnetent 52
+#define KEY_endprotoent 53
+#define KEY_endpwent 54
+#define KEY_endservent 55
+#define KEY_eof 56
+#define KEY_eq 57
+#define KEY_eval 58
+#define KEY_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_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_log 120
+#define KEY_lstat 121
+#define KEY_lt 122
+#define KEY_m 123
+#define KEY_map 124
+#define KEY_mkdir 125
+#define KEY_msgctl 126
+#define KEY_msgget 127
+#define KEY_msgrcv 128
+#define KEY_msgsnd 129
+#define KEY_my 130
+#define KEY_ne 131
+#define KEY_next 132
+#define KEY_no 133
+#define KEY_not 134
+#define KEY_oct 135
+#define KEY_open 136
+#define KEY_opendir 137
+#define KEY_or 138
+#define KEY_ord 139
+#define KEY_pack 140
+#define KEY_package 141
+#define KEY_pipe 142
+#define KEY_pop 143
+#define KEY_pos 144
+#define KEY_print 145
+#define KEY_printf 146
+#define KEY_prototype 147
+#define KEY_push 148
+#define KEY_q 149
+#define KEY_qq 150
+#define KEY_quotemeta 151
+#define KEY_qw 152
+#define KEY_qx 153
+#define KEY_rand 154
+#define KEY_read 155
+#define KEY_readdir 156
+#define KEY_readline 157
+#define KEY_readlink 158
+#define KEY_readpipe 159
+#define KEY_recv 160
+#define KEY_redo 161
+#define KEY_ref 162
+#define KEY_rename 163
+#define KEY_require 164
+#define KEY_reset 165
+#define KEY_return 166
+#define KEY_reverse 167
+#define KEY_rewinddir 168
+#define KEY_rindex 169
+#define KEY_rmdir 170
+#define KEY_s 171
+#define KEY_scalar 172
+#define KEY_seek 173
+#define KEY_seekdir 174
+#define KEY_select 175
+#define KEY_semctl 176
+#define KEY_semget 177
+#define KEY_semop 178
+#define KEY_send 179
+#define KEY_setgrent 180
+#define KEY_sethostent 181
+#define KEY_setnetent 182
+#define KEY_setpgrp 183
+#define KEY_setpriority 184
+#define KEY_setprotoent 185
+#define KEY_setpwent 186
+#define KEY_setservent 187
+#define KEY_setsockopt 188
+#define KEY_shift 189
+#define KEY_shmctl 190
+#define KEY_shmget 191
+#define KEY_shmread 192
+#define KEY_shmwrite 193
+#define KEY_shutdown 194
+#define KEY_sin 195
+#define KEY_sleep 196
+#define KEY_socket 197
+#define KEY_socketpair 198
+#define KEY_sort 199
+#define KEY_splice 200
+#define KEY_split 201
+#define KEY_sprintf 202
+#define KEY_sqrt 203
+#define KEY_srand 204
+#define KEY_stat 205
+#define KEY_study 206
+#define KEY_sub 207
+#define KEY_substr 208
+#define KEY_symlink 209
+#define KEY_syscall 210
+#define KEY_sysopen 211
+#define KEY_sysread 212
+#define KEY_system 213
+#define KEY_syswrite 214
+#define KEY_tell 215
+#define KEY_telldir 216
+#define KEY_tie 217
+#define KEY_tied 218
+#define KEY_time 219
+#define KEY_times 220
+#define KEY_tr 221
+#define KEY_truncate 222
+#define KEY_uc 223
+#define KEY_ucfirst 224
+#define KEY_umask 225
+#define KEY_undef 226
+#define KEY_unless 227
+#define KEY_unlink 228
+#define KEY_unpack 229
+#define KEY_unshift 230
+#define KEY_untie 231
+#define KEY_until 232
+#define KEY_use 233
+#define KEY_utime 234
+#define KEY_values 235
+#define KEY_vec 236
+#define KEY_wait 237
+#define KEY_waitpid 238
+#define KEY_wantarray 239
+#define KEY_warn 240
+#define KEY_while 241
+#define KEY_write 242
+#define KEY_x 243
+#define KEY_xor 244
+#define KEY_y 245
LE
LT
NE
+RESTART
abs
accept
alarm
unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s;
($class, $func_name, $orig_args) = ($1, $2, $3) ;
- ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
- $Full_func_name = "${Packid}_$func_name";
+ ($fname = $func_name) =~ s/^($Prefix)?//;
+ $pname = $Packprefix . $fname;
+ $Full_func_name = "${Packid}_$fname";
# Check for duplicate function definition
for $tmp (@XSStack) {
# print function header
print Q<<"EOF";
-#XS(XS_${Packid}_$func_name)
+#XS(XS_$Full_func_name)
#[[
# dXSARGS;
EOF
sv = NEWSV(1102,0);
sv_upgrade(sv, SVt_PVNV);
sv_setpv(sv, name);
+ if (in_my_stash) {
+ if (*name != '$')
+ croak("Can't declare class for non-scalar %s in \"my\"",name);
+ SvOBJECT_on(sv);
+ (void)SvUPGRADE(sv, SVt_PVMG);
+ SvSTASH(sv) = (HV*)SvREFCNT_inc(in_my_stash);
+ sv_objcount++;
+ }
av_store(comppad_name, off, sv);
SvNVX(sv) = (double)999999999;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
}
}
in_my = FALSE;
+ in_my_stash = Nullhv;
if (lex)
return my(o);
else
av_unshift(endav, 1);
av_store(endav, 0, SvREFCNT_inc(cv));
}
+ else if (strEQ(s, "RESTART") && !error_count) {
+ if (!restartav)
+ restartav = newAV();
+ av_push(restartav, SvREFCNT_inc(cv));
+ }
if (perldb && curstash != debstash) {
SV *sv;
SV *tmpstr = sv_newmortal();
av_unshift(endav, 1);
av_store(endav, 0, SvREFCNT_inc(gv));
}
+ else if (strEQ(s, "RESTART")) {
+ if (!restartav)
+ restartav = newAV();
+ av_push(restartav, SvREFCNT_inc(gv));
+ }
if (!name) {
GvCV(gv) = 0; /* Will remember elsewhere instead. */
CvANON_on(cv);
}
}
break;
+
+ case OP_HELEM: {
+ UNOP *rop;
+ SV *lexname;
+ GV **fields;
+ SV **svp, **indsvp;
+ I32 ind;
+ char *key;
+ STRLEN keylen;
+
+ if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
+ || ((BINOP*)o)->op_last->op_type != OP_CONST)
+ break;
+ rop = (UNOP*)((BINOP*)o)->op_first;
+ if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
+ break;
+ lexname = *av_fetch(comppad_name, rop->op_first->op_targ, TRUE);
+ if (!SvOBJECT(lexname))
+ break;
+ fields = hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+ if (!fields || !GvHV(*fields))
+ break;
+ svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
+ key = SvPV(*svp, keylen);
+ indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+ if (!indsvp) {
+ croak("No such field \"%s\" in variable %s of type %s",
+ key, SvPV(lexname, na), HvNAME(SvSTASH(lexname)));
+ }
+ ind = SvIV(*indsvp);
+ if (ind < 1)
+ croak("Bad index while coercing array into hash");
+ rop->op_type = OP_RV2AV;
+ rop->op_ppaddr = ppaddr[OP_RV2AV];
+ o->op_type = OP_AELEM;
+ o->op_ppaddr = ppaddr[OP_AELEM];
+ SvREFCNT_dec(*svp);
+ *svp = newSViv(ind);
+ break;
+ }
+
default:
o->op_seq = op_seqmax++;
break;
my_exit(0);
}
if (perldb && DBsingle)
- sv_setiv(DBsingle, 1);
+ sv_setiv(DBsingle, 1);
+ if (restartav)
+ calllist(restartav);
}
/* do it */
EXT char * last_lop; /* position of last list operator */
EXT OPCODE last_lop_op; /* last list operator */
EXT bool in_my; /* we're compiling a "my" declaration */
+EXT HV * in_my_stash; /* declared class of this "my" declaration */
#ifdef FCRYPT
EXT I32 cryptseen; /* has fast crypt() been initialized? */
#endif
IEXT SV * Icurstname; /* name of current package */
IEXT AV * Ibeginav; /* names of BEGIN subroutines */
IEXT AV * Iendav; /* names of END subroutines */
+IEXT AV * Irestartav; /* names of RESTART subroutines */
IEXT AV * Ipad; /* storage for lexically scoped temporaries */
IEXT AV * Ipadname; /* variable names for "my" variables */
HE *entry;
I32 i;
char *tmps;
+ I32 realhv = (SvTYPE(hash) == SVt_PVHV);
PUTBACK;
- entry = hv_iternext(hash); /* might clobber stack_sp */
+ /* might clobber stack_sp */
+ entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
SPAGAIN;
EXTEND(SP, 2);
if (entry) {
- tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */
+ tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */
if (!i)
tmps = "";
PUSHs(sv_2mortal(newSVpv(tmps, i)));
if (GIMME == G_ARRAY) {
PUTBACK;
- sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */
+ /* might clobber stack_sp */
+ sv_setsv(TARG, realhv ?
+ hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
SPAGAIN;
PUSHs(TARG);
}
HV *hv = (HV*)POPs;
char *tmps;
STRLEN len;
- if (SvTYPE(hv) != SVt_PVHV) {
+ I32 flags = op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0;
+
+ tmps = SvPV(tmpsv, len);
+ if (SvTYPE(hv) == SVt_PVHV)
+ sv = hv_delete(hv, tmps, len, flags);
+ else if (SvTYPE(hv) == SVt_PVAV) {
+ sv = avhv_delete((AV*)hv, tmps, len, flags);
+ } else {
DIE("Not a HASH reference");
}
- tmps = SvPV(tmpsv, len);
- sv = hv_delete(hv, tmps, len,
- op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
if (!sv)
RETPUSHUNDEF;
PUSHs(sv);
HV *hv = (HV*)POPs;
char *tmps;
STRLEN len;
- if (SvTYPE(hv) != SVt_PVHV) {
+ tmps = SvPV(tmpsv, len);
+ if (SvTYPE(hv) == SVt_PVHV) {
+ if (hv_exists(hv, tmps, len))
+ RETPUSHYES;
+ } else if (SvTYPE(hv) == SVt_PVAV) {
+ if (avhv_exists((AV*)hv, tmps, len))
+ RETPUSHYES;
+ } else {
DIE("Not a HASH reference");
}
- tmps = SvPV(tmpsv, len);
- if (hv_exists(hv, tmps, len))
- RETPUSHYES;
RETPUSHNO;
}
register SV **svp;
register HV *hv = (HV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
+ I32 realhv = (SvTYPE(hv) == SVt_PVHV);
- if (SvTYPE(hv) == SVt_PVHV) {
+ if (realhv || SvTYPE(hv) == SVt_PVAV) {
while (++MARK <= SP) {
STRLEN keylen;
char *key = SvPV(*MARK, keylen);
- svp = hv_fetch(hv, key, keylen, lval);
+ svp = realhv ? hv_fetch(hv, key, keylen, lval)
+ : avhv_fetch((AV*)hv, key, keylen, lval);
if (lval) {
if (!svp || *svp == &sv_undef)
DIE(no_helem, key);
if (SvROK(sv)) {
wasref:
hv = (HV*)SvRV(sv);
- if (SvTYPE(hv) != SVt_PVHV)
+ if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
DIE("Not a HASH reference");
if (op->op_private & OPpLVAL_INTRO)
hv = (HV*)save_svref((SV**)sv);
}
}
else {
- if (SvTYPE(sv) == SVt_PVHV) {
+ if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
hv = (HV*)sv;
if (op->op_flags & OPf_REF) {
SETs((SV*)hv);
}
else {
dTARGET;
+ /* This bit is OK even when hv is really an AV */
if (HvFILL(hv)) {
sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
sv_setpv(TARG, buf);
}
else
sv_setiv(TARG, 0);
+
SETTARG;
RETURN;
}
HV *hv = (HV*)POPs;
I32 lval = op->op_flags & OPf_MOD;
- if (SvTYPE(hv) != SVt_PVHV)
+ if (SvTYPE(hv) == SVt_PVHV)
+ svp = hv_fetch(hv, key, keylen, lval);
+ else if (SvTYPE(hv) == SVt_PVAV)
+ svp = avhv_fetch((AV*)hv, key, keylen, lval);
+ else {
RETPUSHUNDEF;
- svp = hv_fetch(hv, key, keylen, lval);
+ }
if (lval) {
if (!svp || *svp == &sv_undef)
DIE(no_helem, key);
OP* append_list _((I32 optype, LISTOP* first, LISTOP* last));
I32 apply _((I32 type, SV** mark, SV** sp));
void assertref _((OP* op));
+SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags));
+bool avhv_exists _((AV *ar, char* key, U32 klen));
+SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval));
+I32 avhv_iterinit _((AV *ar));
+HE* avhv_iternext _((AV *ar));
+SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen));
+SV* avhv_iterval _((AV *ar, HE* entry));
+SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash));
void av_clear _((AV* ar));
void av_extend _((AV* ar, I32 key));
AV* av_fake _((I32 size, SV** svp));
#!./perl
-if (! -x '/usr/ucb/groups') {
+if (-x '/usr/ucb/groups') {
+ $groups_command = '/usr/ucb/groups';
+} elsif (-x '/usr/bin/groups') {
+ $groups_command = '/usr/bin/groups';
+} else {
print "1..0\n";
exit 0;
}
$gr1 = join(' ', sort @gr);
-$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`/usr/ucb/groups`)));
+$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`$groups_command`)));
if ($gr1 eq $gr2) {
print "ok 1\n";
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
+ case KEY_RESTART:
if (expect == XSTATE) {
s = bufptr;
goto really_sub;
case KEY_my:
in_my = TRUE;
yylval.ival = 1;
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ s = scan_word(s, tokenbuf, TRUE, &len);
+ in_my_stash = gv_stashpv(tokenbuf, FALSE);
+ if (!in_my_stash) {
+ char tmpbuf[1024];
+ bufptr = s;
+ sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
+ yyerror(tmpbuf);
+ }
+ }
OPERATOR(LOCAL);
case KEY_next:
}
else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
break;
+ case 'R':
+ if (strEQ(d,"RESTART")) return KEY_RESTART;
+ break;
case 'r':
switch (len) {
case 3:
croak("%s has too many errors.\n",
SvPVX(GvSV(curcop->cop_filegv)));
in_my = 0;
+ in_my_stash = Nullhv;
return 0;
}
https://perl5.git.perl.org / perl5.git / commitdiff