This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement each @array.
authorNicholas Clark <nick@ccl4.org>
Thu, 20 Dec 2007 21:15:57 +0000 (21:15 +0000)
committerNicholas Clark <nick@ccl4.org>
Thu, 20 Dec 2007 21:15:57 +0000 (21:15 +0000)
Documentation needed, FIXME for proper 64 bit support of arrays longer
than 2**32, re-order the new ops at the end if merging to 5.10.x.

p4raw-id: //depot/perl@32680

14 files changed:
MANIFEST
av.c
embed.fnc
embed.h
ext/Opcode/Opcode.pm
op.c
opcode.h
opcode.pl
opnames.h
pp.c
pp.sym
pp_proto.h
proto.h
t/op/each_array.t [new file with mode: 0644]

index 03a20b4..3a0f6b1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3798,6 +3798,7 @@ t/op/die.t                        See if die works
 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
diff --git a/av.c b/av.c
index 116b7aa..d528ffc 100644 (file)
--- a/av.c
+++ b/av.c
@@ -945,8 +945,8 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
        return FALSE;
 }
 
-SV **
-Perl_av_arylen_p(pTHX_ AV *av) {
+MAGIC *
+S_get_aux_mg(pTHX_ AV *av) {
     dVAR;
     MAGIC *mg;
 
@@ -961,9 +961,22 @@ Perl_av_arylen_p(pTHX_ AV *av) {
        /* 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
index a5a191d..bcbb009 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -115,6 +115,10 @@ Apd        |void   |av_undef       |NN AV* ar
 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
@@ -1215,6 +1219,7 @@ pR        |OP*    |ck_substr      |NN OP *o
 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
diff --git a/embed.h b/embed.h
index 81a08ee..2eebd81 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
index e0078e5..b552f90 100644 (file)
@@ -6,7 +6,7 @@ use strict;
 
 our($VERSION, @ISA, @EXPORT_OK);
 
-$VERSION = "1.11";
+$VERSION = "1.12";
 
 use Carp;
 use Exporter ();
@@ -310,7 +310,7 @@ invert_opset function.
 
     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
diff --git a/op.c b/op.c
index e68b86f..bb6ac62 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7892,6 +7892,27 @@ Perl_ck_substr(pTHX_ OP *o)
     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 */
index 76df85c..a7ca152 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -163,6 +163,9 @@ EXTCONST char* const PL_op_name[] = {
        "aelemfast",
        "aelem",
        "aslice",
+       "aeach",
+       "akeys",
+       "avalues",
        "each",
        "values",
        "keys",
@@ -532,6 +535,9 @@ EXTCONST char* const PL_op_desc[] = {
        "constant array element",
        "array element",
        "array slice",
+       "each on array",
+       "keys on array",
+       "values on array",
        "each",
        "values",
        "keys",
@@ -915,6 +921,9 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        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 */
@@ -1295,9 +1304,12 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        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 */
@@ -1669,6 +1681,9 @@ EXTCONST U32 PL_opargs[] = {
        0x00026c04,     /* aelemfast */
        0x00026404,     /* aelem */
        0x00046801,     /* aslice */
+       0x00007600,     /* aeach */
+       0x00007608,     /* akeys */
+       0x00007608,     /* avalues */
        0x00009600,     /* each */
        0x00009608,     /* values */
        0x00009608,     /* keys */
index 854996d..c65ced3 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -91,6 +91,7 @@ my @raw_alias = (
                 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) {
@@ -736,11 +737,15 @@ aelemfast constant array element  ck_null         s$      A S
 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     
index d2633e6..e0585fb 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -145,242 +145,245 @@ typedef enum opcode {
        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
 
diff --git a/pp.c b/pp.c
index 6d69589..f5ff461 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3929,6 +3929,67 @@ PP(pp_aslice)
     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)
diff --git a/pp.sym b/pp.sym
index f5136ea..fad5f6e 100644 (file)
--- a/pp.sym
+++ b/pp.sym
@@ -12,6 +12,7 @@ Perl_ck_concat
 Perl_ck_defined
 Perl_ck_delete
 Perl_ck_die
+Perl_ck_each
 Perl_ck_eof
 Perl_ck_eval
 Perl_ck_exec
@@ -174,6 +175,9 @@ Perl_pp_rv2av
 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
index 3a96e32..e40122e 100644 (file)
@@ -11,6 +11,7 @@ PERL_CKDEF(Perl_ck_concat)
 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)
@@ -175,6 +176,9 @@ PERL_PPDEF(Perl_pp_rv2av)
 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)
diff --git a/proto.h b/proto.h
index 1aec27a..574fcc8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -189,6 +189,14 @@ PERL_CALLCONV void Perl_av_unshift(pTHX_ AV* ar, I32 num)
 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)
@@ -3264,6 +3272,10 @@ PERL_CALLCONV OP*        Perl_ck_unpack(pTHX_ OP *o)
                        __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);
diff --git a/t/op/each_array.t b/t/op/each_array.t
new file mode 100644 (file)
index 0000000..b0665e1
--- /dev/null
@@ -0,0 +1,132 @@
+#!./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');