t/op/dor.t See if defined-or (//) works
t/op/do.t See if subroutines work
t/op/each.t See if hash iterators work
+t/op/each_array.t See if array iterators work
t/op/eval.t See if eval operator works
t/op/exec.t See if exec, system and qx work
t/op/exists_sub.t See if exists(&sub) works
return FALSE;
}
-SV **
-Perl_av_arylen_p(pTHX_ AV *av) {
+MAGIC *
+S_get_aux_mg(pTHX_ AV *av) {
dVAR;
MAGIC *mg;
/* sv_magicext won't set this for us because we pass in a NULL obj */
mg->mg_flags |= MGf_REFCOUNTED;
}
+ return mg;
+}
+
+SV **
+Perl_av_arylen_p(pTHX_ AV *av) {
+ MAGIC *const mg = get_aux_mg(av);
return &(mg->mg_obj);
}
+/* This will change to returning IV ** at some point soon */
+I32 *
+Perl_av_iter_p(pTHX_ AV *av) {
+ MAGIC *const mg = get_aux_mg(av);
+ return &(mg->mg_len);
+}
+
/*
* Local variables:
* c-indentation-style: bsd
ApdoxM |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val
Apd |void |av_unshift |NN AV* ar|I32 num
Apo |SV** |av_arylen_p |NN AV* av
+AMpo |I32* |av_iter_p |NN AV* av
+#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
+s |MAGIC* |get_aux_mg |NN AV *av
+#endif
pR |OP* |bind_match |I32 type|NN OP* left|NN OP* pat
pR |OP* |block_end |I32 floor|NULLOK OP* seq
ApR |I32 |block_gimme
pR |OP* |ck_svconst |NN OP *o
pR |OP* |ck_trunc |NN OP *o
pR |OP* |ck_unpack |NN OP *o
+pR |OP* |ck_each |NN OP *o
sRn |bool |is_handle_constructor|NN const OP *o|I32 numargs
sR |I32 |is_list_assignment|NULLOK const OP *o
# ifdef USE_ITHREADS
#define av_store Perl_av_store
#define av_undef Perl_av_undef
#define av_unshift Perl_av_unshift
+#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#define get_aux_mg S_get_aux_mg
+#endif
+#endif
#ifdef PERL_CORE
#define bind_match Perl_bind_match
#define block_end Perl_block_end
#define ck_svconst Perl_ck_svconst
#define ck_trunc Perl_ck_trunc
#define ck_unpack Perl_ck_unpack
+#define ck_each Perl_ck_each
#define is_handle_constructor S_is_handle_constructor
#define is_list_assignment S_is_list_assignment
#endif
#define ck_defined Perl_ck_defined
#define ck_delete Perl_ck_delete
#define ck_die Perl_ck_die
+#define ck_each Perl_ck_each
#define ck_eof Perl_ck_eof
#define ck_eval Perl_ck_eval
#define ck_exec Perl_ck_exec
#define pp_abs Perl_pp_abs
#define pp_accept Perl_pp_accept
#define pp_add Perl_pp_add
+#define pp_aeach Perl_pp_aeach
#define pp_aelem Perl_pp_aelem
#define pp_aelemfast Perl_pp_aelemfast
#define pp_alarm Perl_pp_alarm
#define av_store(a,b,c) Perl_av_store(aTHX_ a,b,c)
#define av_undef(a) Perl_av_undef(aTHX_ a)
#define av_unshift(a,b) Perl_av_unshift(aTHX_ a,b)
+#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#define get_aux_mg(a) S_get_aux_mg(aTHX_ a)
+#endif
+#endif
#ifdef PERL_CORE
#define bind_match(a,b,c) Perl_bind_match(aTHX_ a,b,c)
#define block_end(a,b) Perl_block_end(aTHX_ a,b)
#define ck_svconst(a) Perl_ck_svconst(aTHX_ a)
#define ck_trunc(a) Perl_ck_trunc(aTHX_ a)
#define ck_unpack(a) Perl_ck_unpack(aTHX_ a)
+#define ck_each(a) Perl_ck_each(aTHX_ a)
#define is_handle_constructor S_is_handle_constructor
#define is_list_assignment(a) S_is_list_assignment(aTHX_ a)
#endif
#define ck_defined(a) Perl_ck_defined(aTHX_ a)
#define ck_delete(a) Perl_ck_delete(aTHX_ a)
#define ck_die(a) Perl_ck_die(aTHX_ a)
+#define ck_each(a) Perl_ck_each(aTHX_ a)
#define ck_eof(a) Perl_ck_eof(aTHX_ a)
#define ck_eval(a) Perl_ck_eval(aTHX_ a)
#define ck_exec(a) Perl_ck_exec(aTHX_ a)
#define pp_abs() Perl_pp_abs(aTHX)
#define pp_accept() Perl_pp_accept(aTHX)
#define pp_add() Perl_pp_add(aTHX)
+#define pp_aeach() Perl_pp_aeach(aTHX)
#define pp_aelem() Perl_pp_aelem(aTHX)
#define pp_aelemfast() Perl_pp_aelemfast(aTHX)
#define pp_alarm() Perl_pp_alarm(aTHX)
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.11";
+$VERSION = "1.12";
use Carp;
use Exporter ();
rv2av aassign aelem aelemfast aslice av2arylen
- rv2hv helem hslice each values keys exists delete
+ rv2hv helem hslice each values keys exists delete aeach akeys avalues
preinc i_preinc predec i_predec postinc i_postinc postdec i_postdec
int hex oct abs pow multiply i_multiply divide i_divide
return o;
}
+OP *
+Perl_ck_each(pTHX_ OP *o)
+{
+
+ OP *kid = cLISTOPo->op_first;
+
+ if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) {
+ const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH
+ : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
+ o->op_type = new_type;
+ o->op_ppaddr = PL_ppaddr[new_type];
+ }
+ else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV
+ || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE)
+ )) {
+ bad_type(1, "hash or array", PL_op_desc[o->op_type], kid);
+ return o;
+ }
+ return ck_fun(o);
+}
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
"aelemfast",
"aelem",
"aslice",
+ "aeach",
+ "akeys",
+ "avalues",
"each",
"values",
"keys",
"constant array element",
"array element",
"array slice",
+ "each on array",
+ "keys on array",
+ "values on array",
"each",
"values",
"keys",
MEMBER_TO_FPTR(Perl_pp_aelemfast),
MEMBER_TO_FPTR(Perl_pp_aelem),
MEMBER_TO_FPTR(Perl_pp_aslice),
+ MEMBER_TO_FPTR(Perl_pp_aeach),
+ MEMBER_TO_FPTR(Perl_pp_akeys),
+ MEMBER_TO_FPTR(Perl_pp_akeys), /* Perl_pp_avalues */
MEMBER_TO_FPTR(Perl_pp_each),
MEMBER_TO_FPTR(Perl_do_kv), /* Perl_pp_values */
MEMBER_TO_FPTR(Perl_do_kv), /* Perl_pp_keys */
MEMBER_TO_FPTR(Perl_ck_null), /* aelemfast */
MEMBER_TO_FPTR(Perl_ck_null), /* aelem */
MEMBER_TO_FPTR(Perl_ck_null), /* aslice */
- MEMBER_TO_FPTR(Perl_ck_fun), /* each */
- MEMBER_TO_FPTR(Perl_ck_fun), /* values */
- MEMBER_TO_FPTR(Perl_ck_fun), /* keys */
+ MEMBER_TO_FPTR(Perl_ck_each), /* aeach */
+ MEMBER_TO_FPTR(Perl_ck_each), /* akeys */
+ MEMBER_TO_FPTR(Perl_ck_each), /* avalues */
+ MEMBER_TO_FPTR(Perl_ck_each), /* each */
+ MEMBER_TO_FPTR(Perl_ck_each), /* values */
+ MEMBER_TO_FPTR(Perl_ck_each), /* keys */
MEMBER_TO_FPTR(Perl_ck_delete), /* delete */
MEMBER_TO_FPTR(Perl_ck_exists), /* exists */
MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2hv */
0x00026c04, /* aelemfast */
0x00026404, /* aelem */
0x00046801, /* aslice */
+ 0x00007600, /* aeach */
+ 0x00007608, /* akeys */
+ 0x00007608, /* avalues */
0x00009600, /* each */
0x00009608, /* values */
0x00009608, /* keys */
Perl_pp_sin => [qw(cos exp log sqrt)],
Perl_pp_bit_or => ['bit_xor'],
Perl_pp_rv2av => ['rv2hv'],
+ Perl_pp_akeys => ['avalues'],
);
while (my ($func, $names) = splice @raw_alias, 0, 2) {
aelem array element ck_null s2 A S
aslice array slice ck_null m@ A L
+aeach each on array ck_each % A
+akeys keys on array ck_each t% A
+avalues values on array ck_each t% A
+
# Hashes.
-each each ck_fun % H
-values values ck_fun t% H
-keys keys ck_fun t% H
+each each ck_each % H
+values values ck_each t% H
+keys keys ck_each t% H
delete delete ck_delete % S
exists exists ck_exists is% S
rv2hv hash dereference ck_rvconst dt1
OP_AELEMFAST, /* 127 */
OP_AELEM, /* 128 */
OP_ASLICE, /* 129 */
- OP_EACH, /* 130 */
- OP_VALUES, /* 131 */
- OP_KEYS, /* 132 */
- OP_DELETE, /* 133 */
- OP_EXISTS, /* 134 */
- OP_RV2HV, /* 135 */
- OP_HELEM, /* 136 */
- OP_HSLICE, /* 137 */
- OP_UNPACK, /* 138 */
- OP_PACK, /* 139 */
- OP_SPLIT, /* 140 */
- OP_JOIN, /* 141 */
- OP_LIST, /* 142 */
- OP_LSLICE, /* 143 */
- OP_ANONLIST, /* 144 */
- OP_ANONHASH, /* 145 */
- OP_SPLICE, /* 146 */
- OP_PUSH, /* 147 */
- OP_POP, /* 148 */
- OP_SHIFT, /* 149 */
- OP_UNSHIFT, /* 150 */
- OP_SORT, /* 151 */
- OP_REVERSE, /* 152 */
- OP_GREPSTART, /* 153 */
- OP_GREPWHILE, /* 154 */
- OP_MAPSTART, /* 155 */
- OP_MAPWHILE, /* 156 */
- OP_RANGE, /* 157 */
- OP_FLIP, /* 158 */
- OP_FLOP, /* 159 */
- OP_AND, /* 160 */
- OP_OR, /* 161 */
- OP_XOR, /* 162 */
- OP_DOR, /* 163 */
- OP_COND_EXPR, /* 164 */
- OP_ANDASSIGN, /* 165 */
- OP_ORASSIGN, /* 166 */
- OP_DORASSIGN, /* 167 */
- OP_METHOD, /* 168 */
- OP_ENTERSUB, /* 169 */
- OP_LEAVESUB, /* 170 */
- OP_LEAVESUBLV, /* 171 */
- OP_CALLER, /* 172 */
- OP_WARN, /* 173 */
- OP_DIE, /* 174 */
- OP_RESET, /* 175 */
- OP_LINESEQ, /* 176 */
- OP_NEXTSTATE, /* 177 */
- OP_DBSTATE, /* 178 */
- OP_UNSTACK, /* 179 */
- OP_ENTER, /* 180 */
- OP_LEAVE, /* 181 */
- OP_SCOPE, /* 182 */
- OP_ENTERITER, /* 183 */
- OP_ITER, /* 184 */
- OP_ENTERLOOP, /* 185 */
- OP_LEAVELOOP, /* 186 */
- OP_RETURN, /* 187 */
- OP_LAST, /* 188 */
- OP_NEXT, /* 189 */
- OP_REDO, /* 190 */
- OP_DUMP, /* 191 */
- OP_GOTO, /* 192 */
- OP_EXIT, /* 193 */
- OP_SETSTATE, /* 194 */
- OP_METHOD_NAMED,/* 195 */
- OP_ENTERGIVEN, /* 196 */
- OP_LEAVEGIVEN, /* 197 */
- OP_ENTERWHEN, /* 198 */
- OP_LEAVEWHEN, /* 199 */
- OP_BREAK, /* 200 */
- OP_CONTINUE, /* 201 */
- OP_OPEN, /* 202 */
- OP_CLOSE, /* 203 */
- OP_PIPE_OP, /* 204 */
- OP_FILENO, /* 205 */
- OP_UMASK, /* 206 */
- OP_BINMODE, /* 207 */
- OP_TIE, /* 208 */
- OP_UNTIE, /* 209 */
- OP_TIED, /* 210 */
- OP_DBMOPEN, /* 211 */
- OP_DBMCLOSE, /* 212 */
- OP_SSELECT, /* 213 */
- OP_SELECT, /* 214 */
- OP_GETC, /* 215 */
- OP_READ, /* 216 */
- OP_ENTERWRITE, /* 217 */
- OP_LEAVEWRITE, /* 218 */
- OP_PRTF, /* 219 */
- OP_PRINT, /* 220 */
- OP_SAY, /* 221 */
- OP_SYSOPEN, /* 222 */
- OP_SYSSEEK, /* 223 */
- OP_SYSREAD, /* 224 */
- OP_SYSWRITE, /* 225 */
- OP_SEND, /* 226 */
- OP_RECV, /* 227 */
- OP_EOF, /* 228 */
- OP_TELL, /* 229 */
- OP_SEEK, /* 230 */
- OP_TRUNCATE, /* 231 */
- OP_FCNTL, /* 232 */
- OP_IOCTL, /* 233 */
- OP_FLOCK, /* 234 */
- OP_SOCKET, /* 235 */
- OP_SOCKPAIR, /* 236 */
- OP_BIND, /* 237 */
- OP_CONNECT, /* 238 */
- OP_LISTEN, /* 239 */
- OP_ACCEPT, /* 240 */
- OP_SHUTDOWN, /* 241 */
- OP_GSOCKOPT, /* 242 */
- OP_SSOCKOPT, /* 243 */
- OP_GETSOCKNAME, /* 244 */
- OP_GETPEERNAME, /* 245 */
- OP_LSTAT, /* 246 */
- OP_STAT, /* 247 */
- OP_FTRREAD, /* 248 */
- OP_FTRWRITE, /* 249 */
- OP_FTREXEC, /* 250 */
- OP_FTEREAD, /* 251 */
- OP_FTEWRITE, /* 252 */
- OP_FTEEXEC, /* 253 */
- OP_FTIS, /* 254 */
- OP_FTSIZE, /* 255 */
- OP_FTMTIME, /* 256 */
- OP_FTATIME, /* 257 */
- OP_FTCTIME, /* 258 */
- OP_FTROWNED, /* 259 */
- OP_FTEOWNED, /* 260 */
- OP_FTZERO, /* 261 */
- OP_FTSOCK, /* 262 */
- OP_FTCHR, /* 263 */
- OP_FTBLK, /* 264 */
- OP_FTFILE, /* 265 */
- OP_FTDIR, /* 266 */
- OP_FTPIPE, /* 267 */
- OP_FTSUID, /* 268 */
- OP_FTSGID, /* 269 */
- OP_FTSVTX, /* 270 */
- OP_FTLINK, /* 271 */
- OP_FTTTY, /* 272 */
- OP_FTTEXT, /* 273 */
- OP_FTBINARY, /* 274 */
- OP_CHDIR, /* 275 */
- OP_CHOWN, /* 276 */
- OP_CHROOT, /* 277 */
- OP_UNLINK, /* 278 */
- OP_CHMOD, /* 279 */
- OP_UTIME, /* 280 */
- OP_RENAME, /* 281 */
- OP_LINK, /* 282 */
- OP_SYMLINK, /* 283 */
- OP_READLINK, /* 284 */
- OP_MKDIR, /* 285 */
- OP_RMDIR, /* 286 */
- OP_OPEN_DIR, /* 287 */
- OP_READDIR, /* 288 */
- OP_TELLDIR, /* 289 */
- OP_SEEKDIR, /* 290 */
- OP_REWINDDIR, /* 291 */
- OP_CLOSEDIR, /* 292 */
- OP_FORK, /* 293 */
- OP_WAIT, /* 294 */
- OP_WAITPID, /* 295 */
- OP_SYSTEM, /* 296 */
- OP_EXEC, /* 297 */
- OP_KILL, /* 298 */
- OP_GETPPID, /* 299 */
- OP_GETPGRP, /* 300 */
- OP_SETPGRP, /* 301 */
- OP_GETPRIORITY, /* 302 */
- OP_SETPRIORITY, /* 303 */
- OP_TIME, /* 304 */
- OP_TMS, /* 305 */
- OP_LOCALTIME, /* 306 */
- OP_GMTIME, /* 307 */
- OP_ALARM, /* 308 */
- OP_SLEEP, /* 309 */
- OP_SHMGET, /* 310 */
- OP_SHMCTL, /* 311 */
- OP_SHMREAD, /* 312 */
- OP_SHMWRITE, /* 313 */
- OP_MSGGET, /* 314 */
- OP_MSGCTL, /* 315 */
- OP_MSGSND, /* 316 */
- OP_MSGRCV, /* 317 */
- OP_SEMOP, /* 318 */
- OP_SEMGET, /* 319 */
- OP_SEMCTL, /* 320 */
- OP_REQUIRE, /* 321 */
- OP_DOFILE, /* 322 */
- OP_ENTEREVAL, /* 323 */
- OP_LEAVEEVAL, /* 324 */
- OP_ENTERTRY, /* 325 */
- OP_LEAVETRY, /* 326 */
- OP_GHBYNAME, /* 327 */
- OP_GHBYADDR, /* 328 */
- OP_GHOSTENT, /* 329 */
- OP_GNBYNAME, /* 330 */
- OP_GNBYADDR, /* 331 */
- OP_GNETENT, /* 332 */
- OP_GPBYNAME, /* 333 */
- OP_GPBYNUMBER, /* 334 */
- OP_GPROTOENT, /* 335 */
- OP_GSBYNAME, /* 336 */
- OP_GSBYPORT, /* 337 */
- OP_GSERVENT, /* 338 */
- OP_SHOSTENT, /* 339 */
- OP_SNETENT, /* 340 */
- OP_SPROTOENT, /* 341 */
- OP_SSERVENT, /* 342 */
- OP_EHOSTENT, /* 343 */
- OP_ENETENT, /* 344 */
- OP_EPROTOENT, /* 345 */
- OP_ESERVENT, /* 346 */
- OP_GPWNAM, /* 347 */
- OP_GPWUID, /* 348 */
- OP_GPWENT, /* 349 */
- OP_SPWENT, /* 350 */
- OP_EPWENT, /* 351 */
- OP_GGRNAM, /* 352 */
- OP_GGRGID, /* 353 */
- OP_GGRENT, /* 354 */
- OP_SGRENT, /* 355 */
- OP_EGRENT, /* 356 */
- OP_GETLOGIN, /* 357 */
- OP_SYSCALL, /* 358 */
- OP_LOCK, /* 359 */
- OP_ONCE, /* 360 */
- OP_CUSTOM, /* 361 */
+ OP_AEACH, /* 130 */
+ OP_AKEYS, /* 131 */
+ OP_AVALUES, /* 132 */
+ OP_EACH, /* 133 */
+ OP_VALUES, /* 134 */
+ OP_KEYS, /* 135 */
+ OP_DELETE, /* 136 */
+ OP_EXISTS, /* 137 */
+ OP_RV2HV, /* 138 */
+ OP_HELEM, /* 139 */
+ OP_HSLICE, /* 140 */
+ OP_UNPACK, /* 141 */
+ OP_PACK, /* 142 */
+ OP_SPLIT, /* 143 */
+ OP_JOIN, /* 144 */
+ OP_LIST, /* 145 */
+ OP_LSLICE, /* 146 */
+ OP_ANONLIST, /* 147 */
+ OP_ANONHASH, /* 148 */
+ OP_SPLICE, /* 149 */
+ OP_PUSH, /* 150 */
+ OP_POP, /* 151 */
+ OP_SHIFT, /* 152 */
+ OP_UNSHIFT, /* 153 */
+ OP_SORT, /* 154 */
+ OP_REVERSE, /* 155 */
+ OP_GREPSTART, /* 156 */
+ OP_GREPWHILE, /* 157 */
+ OP_MAPSTART, /* 158 */
+ OP_MAPWHILE, /* 159 */
+ OP_RANGE, /* 160 */
+ OP_FLIP, /* 161 */
+ OP_FLOP, /* 162 */
+ OP_AND, /* 163 */
+ OP_OR, /* 164 */
+ OP_XOR, /* 165 */
+ OP_DOR, /* 166 */
+ OP_COND_EXPR, /* 167 */
+ OP_ANDASSIGN, /* 168 */
+ OP_ORASSIGN, /* 169 */
+ OP_DORASSIGN, /* 170 */
+ OP_METHOD, /* 171 */
+ OP_ENTERSUB, /* 172 */
+ OP_LEAVESUB, /* 173 */
+ OP_LEAVESUBLV, /* 174 */
+ OP_CALLER, /* 175 */
+ OP_WARN, /* 176 */
+ OP_DIE, /* 177 */
+ OP_RESET, /* 178 */
+ OP_LINESEQ, /* 179 */
+ OP_NEXTSTATE, /* 180 */
+ OP_DBSTATE, /* 181 */
+ OP_UNSTACK, /* 182 */
+ OP_ENTER, /* 183 */
+ OP_LEAVE, /* 184 */
+ OP_SCOPE, /* 185 */
+ OP_ENTERITER, /* 186 */
+ OP_ITER, /* 187 */
+ OP_ENTERLOOP, /* 188 */
+ OP_LEAVELOOP, /* 189 */
+ OP_RETURN, /* 190 */
+ OP_LAST, /* 191 */
+ OP_NEXT, /* 192 */
+ OP_REDO, /* 193 */
+ OP_DUMP, /* 194 */
+ OP_GOTO, /* 195 */
+ OP_EXIT, /* 196 */
+ OP_SETSTATE, /* 197 */
+ OP_METHOD_NAMED,/* 198 */
+ OP_ENTERGIVEN, /* 199 */
+ OP_LEAVEGIVEN, /* 200 */
+ OP_ENTERWHEN, /* 201 */
+ OP_LEAVEWHEN, /* 202 */
+ OP_BREAK, /* 203 */
+ OP_CONTINUE, /* 204 */
+ OP_OPEN, /* 205 */
+ OP_CLOSE, /* 206 */
+ OP_PIPE_OP, /* 207 */
+ OP_FILENO, /* 208 */
+ OP_UMASK, /* 209 */
+ OP_BINMODE, /* 210 */
+ OP_TIE, /* 211 */
+ OP_UNTIE, /* 212 */
+ OP_TIED, /* 213 */
+ OP_DBMOPEN, /* 214 */
+ OP_DBMCLOSE, /* 215 */
+ OP_SSELECT, /* 216 */
+ OP_SELECT, /* 217 */
+ OP_GETC, /* 218 */
+ OP_READ, /* 219 */
+ OP_ENTERWRITE, /* 220 */
+ OP_LEAVEWRITE, /* 221 */
+ OP_PRTF, /* 222 */
+ OP_PRINT, /* 223 */
+ OP_SAY, /* 224 */
+ OP_SYSOPEN, /* 225 */
+ OP_SYSSEEK, /* 226 */
+ OP_SYSREAD, /* 227 */
+ OP_SYSWRITE, /* 228 */
+ OP_SEND, /* 229 */
+ OP_RECV, /* 230 */
+ OP_EOF, /* 231 */
+ OP_TELL, /* 232 */
+ OP_SEEK, /* 233 */
+ OP_TRUNCATE, /* 234 */
+ OP_FCNTL, /* 235 */
+ OP_IOCTL, /* 236 */
+ OP_FLOCK, /* 237 */
+ OP_SOCKET, /* 238 */
+ OP_SOCKPAIR, /* 239 */
+ OP_BIND, /* 240 */
+ OP_CONNECT, /* 241 */
+ OP_LISTEN, /* 242 */
+ OP_ACCEPT, /* 243 */
+ OP_SHUTDOWN, /* 244 */
+ OP_GSOCKOPT, /* 245 */
+ OP_SSOCKOPT, /* 246 */
+ OP_GETSOCKNAME, /* 247 */
+ OP_GETPEERNAME, /* 248 */
+ OP_LSTAT, /* 249 */
+ OP_STAT, /* 250 */
+ OP_FTRREAD, /* 251 */
+ OP_FTRWRITE, /* 252 */
+ OP_FTREXEC, /* 253 */
+ OP_FTEREAD, /* 254 */
+ OP_FTEWRITE, /* 255 */
+ OP_FTEEXEC, /* 256 */
+ OP_FTIS, /* 257 */
+ OP_FTSIZE, /* 258 */
+ OP_FTMTIME, /* 259 */
+ OP_FTATIME, /* 260 */
+ OP_FTCTIME, /* 261 */
+ OP_FTROWNED, /* 262 */
+ OP_FTEOWNED, /* 263 */
+ OP_FTZERO, /* 264 */
+ OP_FTSOCK, /* 265 */
+ OP_FTCHR, /* 266 */
+ OP_FTBLK, /* 267 */
+ OP_FTFILE, /* 268 */
+ OP_FTDIR, /* 269 */
+ OP_FTPIPE, /* 270 */
+ OP_FTSUID, /* 271 */
+ OP_FTSGID, /* 272 */
+ OP_FTSVTX, /* 273 */
+ OP_FTLINK, /* 274 */
+ OP_FTTTY, /* 275 */
+ OP_FTTEXT, /* 276 */
+ OP_FTBINARY, /* 277 */
+ OP_CHDIR, /* 278 */
+ OP_CHOWN, /* 279 */
+ OP_CHROOT, /* 280 */
+ OP_UNLINK, /* 281 */
+ OP_CHMOD, /* 282 */
+ OP_UTIME, /* 283 */
+ OP_RENAME, /* 284 */
+ OP_LINK, /* 285 */
+ OP_SYMLINK, /* 286 */
+ OP_READLINK, /* 287 */
+ OP_MKDIR, /* 288 */
+ OP_RMDIR, /* 289 */
+ OP_OPEN_DIR, /* 290 */
+ OP_READDIR, /* 291 */
+ OP_TELLDIR, /* 292 */
+ OP_SEEKDIR, /* 293 */
+ OP_REWINDDIR, /* 294 */
+ OP_CLOSEDIR, /* 295 */
+ OP_FORK, /* 296 */
+ OP_WAIT, /* 297 */
+ OP_WAITPID, /* 298 */
+ OP_SYSTEM, /* 299 */
+ OP_EXEC, /* 300 */
+ OP_KILL, /* 301 */
+ OP_GETPPID, /* 302 */
+ OP_GETPGRP, /* 303 */
+ OP_SETPGRP, /* 304 */
+ OP_GETPRIORITY, /* 305 */
+ OP_SETPRIORITY, /* 306 */
+ OP_TIME, /* 307 */
+ OP_TMS, /* 308 */
+ OP_LOCALTIME, /* 309 */
+ OP_GMTIME, /* 310 */
+ OP_ALARM, /* 311 */
+ OP_SLEEP, /* 312 */
+ OP_SHMGET, /* 313 */
+ OP_SHMCTL, /* 314 */
+ OP_SHMREAD, /* 315 */
+ OP_SHMWRITE, /* 316 */
+ OP_MSGGET, /* 317 */
+ OP_MSGCTL, /* 318 */
+ OP_MSGSND, /* 319 */
+ OP_MSGRCV, /* 320 */
+ OP_SEMOP, /* 321 */
+ OP_SEMGET, /* 322 */
+ OP_SEMCTL, /* 323 */
+ OP_REQUIRE, /* 324 */
+ OP_DOFILE, /* 325 */
+ OP_ENTEREVAL, /* 326 */
+ OP_LEAVEEVAL, /* 327 */
+ OP_ENTERTRY, /* 328 */
+ OP_LEAVETRY, /* 329 */
+ OP_GHBYNAME, /* 330 */
+ OP_GHBYADDR, /* 331 */
+ OP_GHOSTENT, /* 332 */
+ OP_GNBYNAME, /* 333 */
+ OP_GNBYADDR, /* 334 */
+ OP_GNETENT, /* 335 */
+ OP_GPBYNAME, /* 336 */
+ OP_GPBYNUMBER, /* 337 */
+ OP_GPROTOENT, /* 338 */
+ OP_GSBYNAME, /* 339 */
+ OP_GSBYPORT, /* 340 */
+ OP_GSERVENT, /* 341 */
+ OP_SHOSTENT, /* 342 */
+ OP_SNETENT, /* 343 */
+ OP_SPROTOENT, /* 344 */
+ OP_SSERVENT, /* 345 */
+ OP_EHOSTENT, /* 346 */
+ OP_ENETENT, /* 347 */
+ OP_EPROTOENT, /* 348 */
+ OP_ESERVENT, /* 349 */
+ OP_GPWNAM, /* 350 */
+ OP_GPWUID, /* 351 */
+ OP_GPWENT, /* 352 */
+ OP_SPWENT, /* 353 */
+ OP_EPWENT, /* 354 */
+ OP_GGRNAM, /* 355 */
+ OP_GGRGID, /* 356 */
+ OP_GGRENT, /* 357 */
+ OP_SGRENT, /* 358 */
+ OP_EGRENT, /* 359 */
+ OP_GETLOGIN, /* 360 */
+ OP_SYSCALL, /* 361 */
+ OP_LOCK, /* 362 */
+ OP_ONCE, /* 363 */
+ OP_CUSTOM, /* 364 */
OP_max
} opcode;
-#define MAXO 362
+#define MAXO 365
#define OP_phoney_INPUT_ONLY -1
#define OP_phoney_OUTPUT_ONLY -2
RETURN;
}
+PP(pp_aeach)
+{
+ dVAR;
+ dSP;
+ AV *array = (AV*)POPs;
+ const I32 gimme = GIMME_V;
+ I32 *iterp = Perl_av_iter_p(aTHX_ array);
+ const IV current = (*iterp)++;
+
+ if (current > av_len(array)) {
+ *iterp = 0;
+ if (gimme == G_SCALAR)
+ RETPUSHUNDEF;
+ else
+ RETURN;
+ }
+
+ EXTEND(SP, 2);
+ mPUSHi(CopARYBASE_get(PL_curcop) + current);
+ if (gimme == G_ARRAY) {
+ SV **const element = av_fetch(array, current, 0);
+ PUSHs(element ? *element : &PL_sv_undef);
+ }
+ RETURN;
+}
+
+PP(pp_akeys)
+{
+ dVAR;
+ dSP;
+ AV *array = (AV*)POPs;
+ const I32 gimme = GIMME_V;
+
+ *Perl_av_iter_p(aTHX_ array) = 0;
+
+ if (gimme == G_SCALAR) {
+ dTARGET;
+ PUSHi(av_len(array) + 1);
+ }
+ else if (gimme == G_ARRAY) {
+ IV n = Perl_av_len(aTHX_ array);
+ IV i = CopARYBASE_get(PL_curcop);
+
+ EXTEND(SP, n + 1);
+
+ if (PL_op->op_type == OP_AKEYS) {
+ n += i;
+ for (; i <= n; i++) {
+ mPUSHi(i);
+ }
+ }
+ else {
+ for (i = 0; i <= n; i++) {
+ SV *const *const elem = Perl_av_fetch(aTHX_ array, i, 0);
+ PUSHs(elem ? *elem : &PL_sv_undef);
+ }
+ }
+ }
+ RETURN;
+}
+
/* Associative arrays. */
PP(pp_each)
Perl_ck_defined
Perl_ck_delete
Perl_ck_die
+Perl_ck_each
Perl_ck_eof
Perl_ck_eval
Perl_ck_exec
Perl_pp_aelemfast
Perl_pp_aelem
Perl_pp_aslice
+Perl_pp_aeach
+Perl_pp_akeys
+Perl_pp_avalues
Perl_pp_each
Perl_pp_values
Perl_pp_keys
PERL_CKDEF(Perl_ck_defined)
PERL_CKDEF(Perl_ck_delete)
PERL_CKDEF(Perl_ck_die)
+PERL_CKDEF(Perl_ck_each)
PERL_CKDEF(Perl_ck_eof)
PERL_CKDEF(Perl_ck_eval)
PERL_CKDEF(Perl_ck_exec)
PERL_PPDEF(Perl_pp_aelemfast)
PERL_PPDEF(Perl_pp_aelem)
PERL_PPDEF(Perl_pp_aslice)
+PERL_PPDEF(Perl_pp_aeach)
+PERL_PPDEF(Perl_pp_akeys)
+PERL_PPDEF(Perl_pp_avalues)
PERL_PPDEF(Perl_pp_each)
PERL_PPDEF(Perl_pp_values)
PERL_PPDEF(Perl_pp_keys)
PERL_CALLCONV SV** Perl_av_arylen_p(pTHX_ AV* av)
__attribute__nonnull__(pTHX_1);
+PERL_CALLCONV I32* Perl_av_iter_p(pTHX_ AV* av)
+ __attribute__nonnull__(pTHX_1);
+
+#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
+STATIC MAGIC* S_get_aux_mg(pTHX_ AV *av)
+ __attribute__nonnull__(pTHX_1);
+
+#endif
PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_2)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
+PERL_CALLCONV OP* Perl_ck_each(pTHX_ OP *o)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+
STATIC bool S_is_handle_constructor(const OP *o, I32 numargs)
__attribute__warn_unused_result__
__attribute__nonnull__(1);
--- /dev/null
+#!./perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+use strict;
+use vars qw(@array @r $k $v);
+
+plan tests => 48;
+
+@array = qw(crunch zam bloop);
+
+(@r) = each @array;
+is (scalar @r, 2);
+is ($r[0], 0);
+is ($r[1], 'crunch');
+($k, $v) = each @array;
+is ($k, 1);
+is ($v, 'zam');
+($k, $v) = each @array;
+is ($k, 2);
+is ($v, 'bloop');
+(@r) = each @array;
+is (scalar @r, 0);
+
+(@r) = each @array;
+is (scalar @r, 2);
+is ($r[0], 0);
+is ($r[1], 'crunch');
+($k) = each @array;
+is ($k, 1);
+{
+ $[ = 2;
+ my ($k, $v) = each @array;
+ is ($k, 4);
+ is ($v, 'bloop');
+ (@r) = each @array;
+ is (scalar @r, 0);
+}
+
+my @lex_array = qw(PLOP SKLIZZORCH RATTLE PBLRBLPSFT);
+
+(@r) = each @lex_array;
+is (scalar @r, 2);
+is ($r[0], 0);
+is ($r[1], 'PLOP');
+($k, $v) = each @lex_array;
+is ($k, 1);
+is ($v, 'SKLIZZORCH');
+($k) = each @lex_array;
+is ($k, 2);
+{
+ $[ = -42;
+ my ($k, $v) = each @lex_array;
+ is ($k, -39);
+ is ($v, 'PBLRBLPSFT');
+}
+(@r) = each @lex_array;
+is (scalar @r, 0);
+
+my $ar = ['bacon'];
+
+(@r) = each @$ar;
+is (scalar @r, 2);
+is ($r[0], 0);
+is ($r[1], 'bacon');
+
+(@r) = each @$ar;
+is (scalar @r, 0);
+
+is (each @$ar, 0);
+is (scalar each @$ar, undef);
+
+my @keys;
+@keys = keys @array;
+is ("@keys", "0 1 2");
+
+@keys = keys @lex_array;
+is ("@keys", "0 1 2 3");
+
+{
+ $[ = 1;
+
+ @keys = keys @array;
+ is ("@keys", "1 2 3");
+
+ @keys = keys @lex_array;
+ is ("@keys", "1 2 3 4");
+}
+
+($k, $v) = each @array;
+is ($k, 0);
+is ($v, 'crunch');
+
+@keys = keys @array;
+is ("@keys", "0 1 2");
+
+($k, $v) = each @array;
+is ($k, 0);
+is ($v, 'crunch');
+
+
+
+my @values;
+@values = values @array;
+is ("@values", "@array");
+
+@values = values @lex_array;
+is ("@values", "@lex_array");
+
+{
+ $[ = 1;
+
+ @values = values @array;
+ is ("@values", "@array");
+
+ @values = values @lex_array;
+ is ("@values", "@lex_array");
+}
+
+($k, $v) = each @array;
+is ($k, 0);
+is ($v, 'crunch');
+
+@values = values @array;
+is ("@values", "@array");
+
+($k, $v) = each @array;
+is ($k, 0);
+is ($v, 'crunch');
projects / p5sagit/p5-mst-13.2.git / commitdiff