Index: MANIFEST =================================================================== --- MANIFEST (revision 26264) +++ MANIFEST (working copy) @@ -1916,7 +1916,6 @@ languages/plumhead/lib/Parrot/Test/Plumhead/Phc.pm [plumhead] languages/plumhead/past_xml.xsd [plumhead] languages/plumhead/plumhead.pl [plumhead] -languages/plumhead/pmc/phparray.pmc [plumhead] languages/plumhead/src/antlr3/GenPastPir.g [plumhead] languages/plumhead/src/antlr3/GenPastPir.java [plumhead] languages/plumhead/src/antlr3/Plumhead.g [plumhead] @@ -1940,7 +1939,6 @@ languages/plumhead/t/php/strings.t [plumhead] languages/plumhead/t/php/superglobals.t [plumhead] languages/plumhead/t/php/variables.t [plumhead] -languages/plumhead/t/pmc/array.t [plumhead] languages/pugs/config/makefiles/root.in [pugs] languages/pugs/include/pugs_common.h [pugs] languages/pugs/pmc/pugsany.pmc [pugs] Index: languages/plumhead/pmc/phparray.pmc =================================================================== --- languages/plumhead/pmc/phparray.pmc (revision 26264) +++ languages/plumhead/pmc/phparray.pmc (working copy) @@ -1,2306 +0,0 @@ -/* -Copyright (C) 2008, The Perl Foundation. -$Id$ - -=head1 NAME - -pmc/phparray.pmc - PHP array - -=head1 DESCRIPTION - -C provides an implementation of PHP arrays. These so-called arrays -are actually hashes which use integer or string keys. Stored vaues may -arbitrarily types. The order of insertion is preserved and can be arbitrarily -reordered independently of keys and values. - -=head2 Methods - -=over 4 - -=cut - -*/ - -#include "parrot/parrot.h" - -#define HASH_SEED 12345 -#define PMC_type(pmc) ((pmc)->vtable->base_type) - -#if 0 -# define dprintf(...) printf(__VA_ARGS__) -#else -# define dprintf(...) -#endif - -#define PREPEND_TO_BUCKET_LIST(b, list) \ - if ((list) == NULL) { \ - (list) = (b); \ - (b)->bucketNext = NULL; \ - (b)->bucketPrev = NULL; \ - } \ - else { \ - (list)->bucketPrev = (b); \ - (b)->bucketNext = (list); \ - (b)->bucketPrev = NULL; \ - (list) = (b); \ - } - -#define PREPEND_TO_TABLE_LIST(b, list) \ - if ((list)->tableHead == NULL) { \ - (list)->internalPointer = (b); \ - (list)->tableHead = (b); \ - (list)->tableTail = (b); \ - } \ - else { \ - (list)->tableHead->tablePrev = (b); \ - (b)->tableNext = (list)->tableHead; \ - (b)->tablePrev = NULL; \ - (list)->tableHead = (b); \ - } - -#define APPEND_TO_TABLE_LIST(b, list) \ - if ((list)->tableHead == NULL) { \ - (list)->internalPointer = (b); \ - (list)->tableHead = (b); \ - (list)->tableTail = (b); \ - } \ - else { \ - (list)->tableTail->tableNext = (b); \ - (b)->tablePrev = (list)->tableTail; \ - (b)->tableNext = NULL; \ - (list)->tableTail = (b); \ - } - -#define DELETE_FROM_TABLE_LIST(b, list) \ - (list)->internalPointer = (b)->tableNext; \ - if ((list)->tableHead == (b)) \ - (list)->tableHead = (b)->tableNext; \ - else \ - (b)->tablePrev->tableNext = (b)->tableNext; \ - if ((list)->tableTail == (b)) \ - (list)->tableTail = (b)->tablePrev; \ - else \ - (b)->tableNext->tablePrev = (b)->tablePrev; \ - -#define DELETE_FROM_BUCKET_LIST(b, list) \ - if ((list) == (b)) \ - (list) = (b)->bucketNext; \ - else \ - (b)->bucketPrev->bucketNext = (b)->bucketNext; \ - if ((b)->bucketNext != NULL) \ - (b)->bucketNext->bucketPrev = (b)->bucketPrev; \ - -/* These aren't VTABLE methods, but it's easier to pretend that they are. See - * RT #50878 */ -#define VTABLE_is_equal(a, b, c) mmd_dispatch_i_pp((a), (b), (c), MMD_EQ) -#define VTABLE_cmp(a, b, c) mmd_dispatch_i_pp((a), (b), (c), MMD_CMP) - -typedef enum { - APPEND, - PREPEND -} add_type; - - -typedef struct bucket { - struct bucket *tableNext; - struct bucket *tablePrev; - struct bucket *bucketNext; - struct bucket *bucketPrev; - PMC *key; - PMC *value; - INTVAL hash; -} Bucket; - -typedef struct hashtable { - Bucket *internalPointer; - Bucket *tableHead; - Bucket *tableTail; - Bucket **buckets; - INTVAL elementCount; - INTVAL capacity; - INTVAL hashMask; - INTVAL nextIndex; -} HashTable; - -void array_key_convert(PARROT_INTERP, PMC **key); -void add_to_hashtable(PARROT_INTERP, HashTable*, PMC*, PMC*, add_type); -PMC* get_from_hashtable(PARROT_INTERP, HashTable*, PMC*); -PMC* delete_from_hashtable(PARROT_INTERP, HashTable *, PMC*); -INTVAL find_in_hashtable(PARROT_INTERP, HashTable*, PMC*); -INTVAL phparray_hash(PARROT_INTERP, PMC*); -void hash_check(PARROT_INTERP, HashTable*); -void renumber_hash(PARROT_INTERP, HashTable*); -void resize_and_rehash(PARROT_INTERP, HashTable*); - -INTVAL phparray_hash(PARROT_INTERP, PMC *key) { - if (PMC_type(key) == enum_class_Integer) - return VTABLE_get_integer(interp, key); - else if (PMC_type(key) == enum_class_String) { - STRING *key_str = VTABLE_get_string(interp, key); - return string_hash(interp, key_str, HASH_SEED); - } - else - real_exception(interp, NULL, INVALID_OPERATION, - "must use integer or string keys in phparray_hash"); -} - -/*If the key is a String PMC and can be converted an integer according to PHP's rules, do so*/ -void array_key_convert(PARROT_INTERP, PMC **key) { - - STRING *key_str, *c0, *c1; - PMC *index_pmc; - - /*try to convert the string to an int*/ - if (PMC_type(*key) == enum_class_String) { - - index_pmc = pmc_new(interp, enum_class_Integer); - VTABLE_set_integer_native(interp, index_pmc, (INTVAL)0); - - /*if there's only one char and it's a digit*/ - if (VTABLE_elements(interp, *key) == 1) { - c0 = VTABLE_get_string_keyed(interp, *key, index_pmc); - - /*I should be able to get away with this when I'm just checking the first char*/ - if (isdigit((unsigned char)*(c0->strstart))) { - INTVAL key_int = VTABLE_get_integer(interp, *key); - *key = pmc_new(interp, enum_class_Integer); - VTABLE_set_integer_native(interp, *key, key_int); - dprintf("converting string key %d to int key\n", (int)key_int); - } - } - else { - INTVAL key_int = VTABLE_get_integer(interp, *key); - c0 = VTABLE_get_string_keyed(interp, *key, index_pmc); - VTABLE_increment(interp, index_pmc); - c1 = VTABLE_get_string_keyed(interp, *key, index_pmc); - if (key_int != 0 && *c0->strstart != '0' && *c0->strstart != '-') { - *key = pmc_new(interp, enum_class_Integer); - VTABLE_set_integer_native(interp, *key, key_int); - dprintf("converting string key %d to int key\n", (int)key_int); - } - else if (*c0->strstart == '-' && *c1->strstart != '0') { - *key = pmc_new(interp, enum_class_Integer); - VTABLE_set_integer_native(interp, *key, key_int); - dprintf("converting string key %d to int key\n", (int)key_int); - } - } - } -} - -void add_to_hashtable(PARROT_INTERP, HashTable *ht, PMC *key, PMC *value, add_type type) { - - uint index; - Bucket *newB, *b; - INTVAL curr_index, hash; - char *key_cstr, *value_cstr; - - array_key_convert(interp, &key); - - hash = phparray_hash(interp, key); - index = ht->hashMask & hash; - b = ht->buckets[index]; - - if (PMC_type(key) == enum_class_Integer && VTABLE_get_integer(interp, key) >= ht->nextIndex) { - - curr_index = VTABLE_get_integer(interp, key); - if (curr_index < 0) - ht->nextIndex = 0; - else - ht->nextIndex = ++curr_index; - dprintf("nextIndex changed to %d\n", (int)ht->nextIndex); - } - else if (PMC_type(key) == enum_class_Integer) - dprintf("nextIndex is %d, inserted key is %d\n", (int)ht->nextIndex, - (int)VTABLE_get_integer(interp, key)); - else { - dprintf("nextIndex doesn't care because key is a string\n"); - } - - dprintf("storing item with hash %X of type %d in bucket #%d of hashtable at 0x%X\n", - (uint)hash, (uint)PMC_type(value), index, (uint)ht); - key_cstr = string_to_cstring(interp, VTABLE_get_string(interp, key)); - value_cstr = string_to_cstring(interp, VTABLE_get_string(interp, value)); - dprintf("pair maps \"%s\" => \"%s\"\n", key_cstr, value_cstr); - string_cstring_free(key_cstr); - string_cstring_free(value_cstr); - - while (b != NULL) { - if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) { - b->value = value; - return; - } - b = b->bucketNext; - } - dprintf("key hasn't been used yet; making new bucket\n"); - - newB = (Bucket*) mem_allocate_zeroed_typed(Bucket); - newB->key = key; - newB->value = value; - newB->hash = hash; - PREPEND_TO_BUCKET_LIST(newB, ht->buckets[index]); - - if (type == APPEND) { - APPEND_TO_TABLE_LIST(newB, ht); - } else if (type == PREPEND) { - PREPEND_TO_TABLE_LIST(newB, ht); - } - ht->elementCount++; - - hash_check(interp, ht); - if (ht->elementCount <= ht->capacity) - return; - resize_and_rehash(interp, ht); -} - -PMC* delete_from_hashtable(PARROT_INTERP, HashTable *ht, PMC *key) { - - INTVAL hash = phparray_hash(interp, key); - INTVAL index; - Bucket *b; - PMC *pmc; - - array_key_convert(interp, &key); - - index = ht->hashMask & hash; - b = ht->buckets[index]; - - while (b != NULL) { - if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) { - DELETE_FROM_BUCKET_LIST(b, ht->buckets[index]); - DELETE_FROM_TABLE_LIST(b, ht); - - pmc = b->value; - return pmc; - } - b = b->bucketNext; - ht->elementCount--; - } - dprintf("the thing doesn't seem to be in the hash\n"); - - hash_check(interp, ht); - return PMCNULL; -} - -PMC* get_from_hashtable(PARROT_INTERP, HashTable *ht, PMC *key) { - INTVAL index, hash, i; - Bucket *b; - - array_key_convert(interp, &key); - - hash = phparray_hash(interp, key); - index = ht->hashMask & hash; - b = ht->buckets[index]; - - i = 0; - dprintf("getting thing with hash %X in hashtable\n", (uint)hash); - while (b != NULL) { - dprintf("searching bucket #%d with key at 0X%X and b->key at 0X%X\n", - (int)i, (uint)key, (uint)b->key); - i++; - if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) { - return b->value; - } - b = b->bucketNext; - } - dprintf("thing not found\n"); - return PMCNULL; -} - -INTVAL find_in_hashtable(PARROT_INTERP, HashTable *ht, PMC *key) { - INTVAL hash = phparray_hash(interp, key); - INTVAL index, i; - Bucket *b; - - index = ht->hashMask & hash; - b = ht->buckets[index]; - - i = 0; - dprintf("looking for thing with hash %X in hashtable\n", (uint)hash); - while (b != NULL) { - dprintf("searching bucket #%d with key at %X and b->key at %X\n", - (int)i, (uint)key, (uint)b->key); - i++; - if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) { - return 1; - } - b = b->bucketNext; - } - return 0; -} - -void hash_check(PARROT_INTERP, HashTable *ht) { - - INTVAL i, bucket_order_count, insert_order_count; - int key_type, value_type; - char *key_str, *value_str; - Bucket *b; - - dprintf("checking hash at %X\n", (uint)ht); - dprintf("capacity = %d, mask = %d, elementCount = %d, nextIndex = %d\n", - (int)ht->capacity, (int)ht->hashMask, (int)ht->elementCount, (int)ht->nextIndex); - bucket_order_count = 0; - for (i = 0; i < ht->capacity; i++) { - Bucket *b = ht->buckets[i]; - dprintf("checking bucket #%d...", (int)i); - while (b != NULL) { - key_type = PMC_type(b->key); - value_type = PMC_type(b->value); - key_str = string_to_cstring(interp, VTABLE_get_string(interp, b->key)); - value_str = string_to_cstring(interp, VTABLE_get_string(interp, b->value)); - dprintf("\n bucket at 0x%X maps \"%s\"(%d) => \"%s\"(%d)", - (uint)b, key_str, (uint)key_type, value_str, (uint)value_type); - string_cstring_free(key_str); - string_cstring_free(value_str); - b = b->bucketNext; - bucket_order_count++; - } - dprintf("\n"); - } - dprintf("now checking by insertion order\n"); - b = ht->tableHead; - insert_order_count = 0; - while (b != NULL) { - key_type = PMC_type(b->key); - value_type = PMC_type(b->value); - key_str = string_to_cstring(interp, VTABLE_get_string(interp, b->key)); - value_str = string_to_cstring(interp, VTABLE_get_string(interp, b->value)); - dprintf(" bucket at 0x%X maps \"%s\"(%d) => \"%s\"(%d)\n", - (uint)b, key_str, (uint)key_type, value_str, (uint)value_type); - string_cstring_free(key_str); - string_cstring_free(value_str); - b = b->tableNext; - insert_order_count++; - } - dprintf("%d buckets expected, %d found by bucket order, %d found by insert order\n", - (int)ht->elementCount, (int)bucket_order_count, (int)insert_order_count); -} - -void renumber_hash(PARROT_INTERP, HashTable *ht) { - Bucket *b; - INTVAL index; - - b = ht->tableHead; - dprintf("renumbering hash at %X\n", (uint)ht); - index = 0; - while (b != NULL) { - if (PMC_type(b->key) == enum_class_Integer) { - VTABLE_set_integer_native(interp, b->key, index); - index++; - } - b = b->bucketNext; - } - ht->nextIndex = ++index; -} - -void resize_and_rehash(PARROT_INTERP, HashTable *ht) { - Bucket **buckets; - Bucket *b; - INTVAL index; - - hash_check(interp, ht); - - - /* resize*/ - mem_sys_free(ht->buckets); - ht->capacity <<= 1; - ht->hashMask = ht->capacity - 1; - ht->buckets = (Bucket**)mem_allocate_n_zeroed_typed(ht->capacity, Bucket); - - /* rehash*/ - b = ht->tableHead; - while (b != NULL) { - index = b->hash & ht->hashMask; - PREPEND_TO_BUCKET_LIST(b, ht->buckets[index]); - b = b->tableNext; - }; - - hash_check(interp, ht); -} - -pmclass PHPArray - provides hash - provides array - need_ext - dynpmc - group php_group - hll PHP { - -/* - -=item C - -=item C - -Insert all key/value pairs from the second array into the first - -=cut - -*/ - - - /*dest = self + value */ - PMC* add(PMC *value, PMC *dest) { - /* check for aggregates */ - - /* check for scalars */ - } - - /*self = self + value*/ - void i_add(PMC *value) { - } - -/* - -=item C - -Determine equality between this and another PMC. Two PHPArrays PMCs are equal -if they contain the same key/value pairs, regardless of order. This is the -same behavoir that is found in PHP. - -Currently, only two PHPArray PMCs can be considered equal. It is possible for -equality comparisons to be extended to other PMCs via the VTABLE API. - -=cut - -*/ - INTVAL is_equal(PMC *value) { - /*XXX: figure out what it's appropriate to compare this PMC to. - ATM I'm thinking soemthing like - VTABLE_does(hash) && VTABLE_does(array) && all key/value pairs match - */ - return (INTVAL)0; - } - -/* - -=item C - -=item C - -Determine equality between this PHPArray PMC and a string or number. According -to PHP an array is never equal to a string or number. If only everything were -that easy. - -=cut - -*/ - INTVAL is_equal_num(PMC *value) { - return (INTVAL)0; - } - - INTVAL is_equal_string(PMC *value) { - return (INTVAL)0; - } - -/* - -=item C - -=item C - -=item C - -Compare a PHPArray to another PMC. A PHPArray is always greater than a STRING, -INTVAL or FLOATVAL. Given two PHPArrays C and C, C is greater than b -if all of the following are true: - -=over 4 - -=item * C and C have the same number of elements and the same keys. - -=item * The values of C are greater than the values of C, according to C's internal order. - -=back - -Note that this means it is possible for both C > C and C > C to be -true. Zend PHP's behavior is to return null when two arrays aren't comparable. -B An C between two -uncomparable PHPArrays will return 1. - -=cut - -*/ - INTVAL cmp(PMC *other) { - INTVAL self_size, other_size, diff; - Bucket *b; - HashTable *self_ht, *other_ht; - PMC *self_value, *other_value; - STRING *self_str, *other_str; - char *self_cstr, *other_cstr; - dprintf("comparing PMCs\n"); - - if (PMC_type(other) != PMC_type(SELF)) - return 1; - - self_ht = (HashTable*)PMC_struct_val(SELF); - other_ht = (HashTable*)PMC_struct_val(other); - - /*compare size*/ - self_size = self_ht->elementCount; - other_size = other_ht->elementCount; - dprintf("self size is %d, other is %d\n", (int)self_size, (int)other_size); - - if (self_size > other_size) { - dprintf("self is bigger: returning 1\n"); - return (INTVAL)1; - } - else if (other_size > self_size) { - dprintf("other is bigger: returning -1\n"); - return (INTVAL)-1; - } - - /*iterate through keys according to SELF order */ - dprintf("comparing values\n"); - for (b = self_ht->tableHead; b != NULL; b = b->tableNext) { - other_value = get_from_hashtable(INTERP, other_ht, b->key); - if (other_value == PMCNULL) - return 1; - self_value = b->value; - diff = VTABLE_cmp(INTERP, self_value, other_value); - - self_str = VTABLE_get_string(INTERP, self_value); - other_str = VTABLE_get_string(INTERP, other_value); - self_cstr = string_to_cstring(INTERP, self_str); - other_cstr = string_to_cstring(INTERP, other_str); - dprintf("result of comparing '%s' to '%s': %d\n", self_cstr, other_cstr, (int)diff); - - - if (diff) - return diff; - } - - return (INTVAL)0; - } - - INTVAL cmp_num(PMC *value) { - return (INTVAL)1; - } - - INTVAL cmp_string(PMC *value) { - return (INTVAL)1; - } - -/* - -=item C - -If the passed-in PMC is array-like and/or hash-like, copy all key/value pairs -into this PMC. If the PMC is a PHPArray, make a clone. - -=cut - -*/ - - void assign_pmc(PMC *value) { - Bucket *b1, *b2; - INTVAL new_size; - PMC *new_key, *new_value; - HashTable *orig_ht, *new_ht; - - orig_ht = (HashTable*) PMC_struct_val(SELF); - new_size = orig_ht->elementCount; - - if (PMC_type(value) == PMC_type(SELF)) { - new_ht = (HashTable*) PMC_struct_val(value); - /*XXX: do I need to delete the old value?*/ - /*delete everything in value*/ - /*free all buckets*/ - b1 = new_ht->tableHead; - while (b1 != NULL) { - b2 = b1; - b1 = b1->tableNext; - mem_sys_free(b2); - } - if (new_size > new_ht->elementCount) { - /*resize it to this PMC*/ - mem_sys_free(new_ht->buckets); - new_ht->buckets = (Bucket**) - mem_allocate_n_zeroed_typed(new_size, Bucket); - new_ht->elementCount = new_size; - new_ht->hashMask = orig_ht->hashMask; - } - - b1 = orig_ht->tableHead; - /* XXX: it'd probably be better to implement COW here*/ - while (b1 != NULL) { - /*XXX: implement: insert copies of key/value pairs*/ - - } - - } - else { - /*do the Right Thing according to whether the passed-in PMC - * implements a hash-like and/or array-like interface*/ - } - } - -/* - -=item C - -Return a clone of this PHPArray. - -=cut - -*/ - - PMC* clone() { - return PMCNULL; - } - - /* nothing else implements this, so I won't either - PMC* clone_pmc (PMC *args) { - return PMCNULL; - }*/ - -/* - -=item C - -=item C - -=item C - -Remove the element at key. - -=cut - -*/ - - void delete_keyed(PMC *key) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char *key_cstr, *val_cstr; - char key_is_int; - - if (key == NULL) { - return; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("delete_keyed called with key = %s\n", key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("delete_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, index_s); - dprintf("delete_keyed: string index is '%s'\n", key_cstr); - string_cstring_free(key_cstr); - key_is_int = 0; - } - else { - dprintf("exception from delete_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - SELF.delete_keyed_int(index_i); - return; - } - else if (next_key == NULL && !key_is_int) { - SELF.delete_keyed_str(index_s); - return; - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == PMCNULL) { - return; - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - string_cstring_free(cstr); - if (box == PMCNULL) { - return; - } - } - else { - dprintf("exception from delete_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - VTABLE_delete_keyed(INTERP, box, next_key); - } - - void delete_keyed_int(INTVAL key) { - PMC *key_pmc; - dprintf("called delete_keyed_int\n"); - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - delete_from_hashtable(INTERP, (HashTable*) PMC_struct_val(SELF), key_pmc); - } - - void delete_keyed_str(STRING *key) { - PMC *key_pmc; - dprintf("called delete_keyed_str\n"); - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - delete_from_hashtable(INTERP, (HashTable*) PMC_struct_val(SELF), key_pmc); - } - -/* - -=item C - -Free the memory associated with this PHPArray's underlying structs. - -=cut - -*/ - - void destroy() { - if (PMC_struct_val(SELF)) { - HashTable *ht = (HashTable *)PMC_struct_val(SELF); - Bucket *b1 = ht->tableHead; - while (b1) { - Bucket *b2 = b1; - b1 = b1->tableNext; - mem_sys_free(b2); - } - - mem_sys_free(ht->buckets); - mem_sys_free(ht); - } - } - -/* - -=item C - -Returns the number of elements in this PHPArray. - -=cut - -*/ - INTVAL elements() { - HashTable *ht = (HashTable*)PMC_struct_val(SELF); - return (INTVAL) ht->elementCount; - } - -/* - -=item C - -=item C - -=item C - -Returns TRUE if the element at C exists; otherwise returns false. - -=cut - -*/ - INTVAL exists_keyed(PMC *key) { - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char *key_cstr, *val_cstr; - char key_is_int; - - if (key == NULL) { - return 0; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("exists_keyed called with key = %s\n", key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("exists_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, index_s); - dprintf("exists_keyed: string index is '%s'\n", key_cstr); - string_cstring_free(key_cstr); - key_is_int = 0; - } - else { - dprintf("exception from exists_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - return SELF.exists_keyed_int(index_i); - } - else if (next_key == NULL && !key_is_int) { - return SELF.exists_keyed_str(index_s); - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == PMCNULL) { - return (INTVAL)0; - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - string_cstring_free(cstr); - if (box == PMCNULL) { - return (INTVAL)0; - } - } - else { - dprintf("exception from exists_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_exists_keyed(INTERP, box, next_key); - } - - INTVAL exists_keyed_int(INTVAL key) { - PMC *key_pmc; - dprintf("called exists_keyed_int\n"); - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - return find_in_hashtable(INTERP, (HashTable*) PMC_struct_val(SELF), key_pmc); - } - - INTVAL exists_keyed_str(STRING *key) { - PMC *key_pmc; - dprintf("called exists_keyed_int\n"); - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - return find_in_hashtable(INTERP, (HashTable*) PMC_struct_val(SELF), key_pmc); - } -/* - -=item C - -Return TRUE if this PHPArray has one or more elements, return FALSE otherwise. - -=cut - -*/ - INTVAL get_bool() { - return SELF.elements() >= 1; - } -/* - -=item C - -=item C - -=item C - -Return the integer value of the elements a C. - -=cut - -*/ - - INTVAL get_integer_keyed(PMC *key) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char key_is_int; - char *key_cstr; - - if (key == NULL) { - return 0; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("get_integer_keyed called with key = %s\n", key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("get_integer_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from get_integer_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - return SELF.get_integer_keyed_int(index_i); - } - else if (next_key == NULL && !key_is_int) { - return SELF.get_integer_keyed_str(index_s); - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == NULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == NULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_integer_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_get_integer_keyed(INTERP, box, next_key); - - } - - INTVAL get_integer_keyed_int(INTVAL key) { - PMC *key_pmc, *value; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - value = get_from_hashtable(INTERP, ht, key_pmc); - - if (value == PMCNULL) - return 0; - - return VTABLE_get_integer(INTERP, value); - } - - INTVAL get_integer_keyed_str(STRING *key) { - PMC *key_pmc, *value; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - value = get_from_hashtable(INTERP, ht, key_pmc); - - if (value == PMCNULL) - return 0; - - return VTABLE_get_integer(INTERP, value); - } - -/* - -=item C - -=item C - -=item C - -Return the float value of the element at C. - -=cut - -*/ - - FLOATVAL get_number_keyed(PMC *key) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char key_is_int; - char *key_cstr; - - if (key == NULL) { - return 0; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("get_number_keyed called with key = %s\n", key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("get_number_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from get_number_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - return SELF.get_number_keyed_int(index_i); - } - else if (next_key == NULL && !key_is_int) { - return SELF.get_number_keyed_str(index_s); - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == NULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == NULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_number_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_get_number_keyed(INTERP, box, next_key); - - } - - FLOATVAL get_number_keyed_int(INTVAL key) { - PMC *key_pmc, *value; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - value = get_from_hashtable(INTERP, ht, key_pmc); - - if (value == PMCNULL) - return 0.0; - - return VTABLE_get_number(INTERP, value); - } - - FLOATVAL get_number_keyed_str(STRING *key) { - PMC *key_pmc, *value; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - value = get_from_hashtable(INTERP, ht, key_pmc); - - if (value == PMCNULL) - return 0.0; - - return VTABLE_get_number(INTERP, value); - } -/* - -=item C - -Return a new iterator for this PHPArray. - -=cut - -*/ - PMC* get_iter() { - PMC *iter = pmc_new_init(INTERP, enum_class_Iterator, SELF); - PMC *key = pmc_new(INTERP, enum_class_Key); - - PMC_struct_val(iter) = key; - PMC_int_val(iter) = 1; - - /*tell Parrot_Key_nextkey_keyed to let me do my own iterating*/ - PObj_get_FLAGS(key) |= KEY_hash_iterator_FLAGS; - - return iter; - } - - -/* - -=item C - -=item C - -=item C - -Return the string value of the element at C. - -=cut - -*/ - - PMC* get_pmc_keyed(PMC *key) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char key_is_int; - char *key_cstr; - HashTable *ht; - - ht = (HashTable*)PMC_struct_val(SELF); - - if (key == NULL) { - return 0; - } - else if (PObj_get_FLAGS(key) & KEY_hash_iterator_FLAGS) { - dprintf("pmc keyed magic time\n"); - if (ht->internalPointer == NULL) { - return PMCNULL; - } - next_key = ht->internalPointer->key; - ht->internalPointer = ht->internalPointer->tableNext; - return next_key; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("get_pmc_keyed called with key = %s\n", key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("get_pmc_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from get_pmc_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the aggregate PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - return SELF.get_pmc_keyed_int(index_i); - } - else if (next_key == NULL && !key_is_int) { - return SELF.get_pmc_keyed_str(index_s); - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == NULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == NULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_pmc_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_get_pmc_keyed(INTERP, box, next_key); - } - - PMC *get_pmc_keyed_int(INTVAL key) { - PMC *key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - hash_check(INTERP, (HashTable*) PMC_struct_val(SELF)); - return get_from_hashtable(INTERP, (HashTable*)PMC_struct_val(SELF), key_pmc); - } - - PMC* get_pmc_keyed_str(STRING *key) { - PMC *key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - hash_check(INTERP, (HashTable*) PMC_struct_val(SELF)); - return get_from_hashtable(INTERP, (HashTable*)PMC_struct_val(SELF), key_pmc); - } - -/* - -=item C - -Return the string representation of this array. This is simply the string C. - -=cut - -*/ - STRING* get_string() { - return const_string(INTERP, "Array"); - } - -/* - -=item C - -=item C - -=item C - -Return the string value of the element at C. - -=cut - -*/ - STRING* get_string_keyed(PMC *key) { - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char key_is_int; - char *key_cstr; - - if (key == NULL) { - return 0; - } - if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("get_string_keyed called with key = %s\n", key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("get_string_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from get_string_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - return SELF.get_string_keyed_int(index_i); - } - else if (next_key == NULL && !key_is_int) { - return SELF.get_string_keyed_str(index_s); - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == NULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == NULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from get_string_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_get_string_keyed(INTERP, box, next_key); - - } - - STRING* get_string_keyed_int(INTVAL key) { - PMC *key_pmc, *value; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - value = get_from_hashtable(INTERP, ht, key_pmc); - - if (value == PMCNULL) - return const_string(INTERP, ""); - - return VTABLE_get_string(INTERP, value); - } - - STRING* get_string_keyed_str(STRING *key) { - PMC *key_pmc, *value; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - value = get_from_hashtable(INTERP, ht, key_pmc); - - if (value == PMCNULL) - return const_string(INTERP, ""); - - return VTABLE_get_string(INTERP, value); - } - -/* - -=item C - -=item C - -Initialize this PHPArray's internal structures - -=cut - -*/ - void init() { - HashTable *ht; - - PObj_custom_mark_destroy_SETALL(SELF); - - ht = mem_allocate_zeroed_typed(HashTable); - /*initialize the hash to contain 4 buckets*/ - ht->capacity = 4; - ht->hashMask = ht->capacity - 1; - ht->buckets = (Bucket**)mem_allocate_n_zeroed_typed(ht->capacity, Bucket); - PMC_struct_val(SELF) = ht; - - } - - void init_pmc(PMC *initializer) { - if (initializer == PMCNULL) - SELF.init(); - } - - /* not sure if I care about these - PMC* inspect () { - return PMCNULL; - } - - PMC* inspect_str (STRING *what) { - return PMCNULL; - } - - PMC* instantiate (PMC *sig) { - return PMCNULL; - } - - opcode_t* invoke (void *next) { - return (opcode_t*)0; - }*/ - - -/* - -=item C - -Return TRUE if this PHPArray and the passed-in PMC refer to the same region in memory. - -=cut - -*/ - INTVAL is_same(PMC *other) { - return PMC_struct_val(other) == PMC_struct_val(SELF) && - other->vtable == SELF->vtable; - } - -/* - -=item C - -Mark the PHPArray and all contents as live. - -=cut - -*/ - void mark() { - HashTable *ht = (HashTable *)PMC_struct_val(SELF); - INTVAL elementCount = ht->elementCount; - int i; - - dprintf("marking hash at %X\n", (uint)ht); - - for (i = 0; i < elementCount; i++) { - Bucket *b = ht->buckets[i]; - dprintf("marking bucket #%d\n", i); - - while (b) { - pobject_lives(INTERP, (PObj *)b->key); - pobject_lives(INTERP, (PObj *)b->value); - b = b->bucketNext; - } - } - } - - /*XXX: I'm pretty sure I don't need to implement these, but - I'm leaving them here until I understand the Iterator PMC - well enough to do otherwise. - - PMC* nextkey_keyed (PMC *key, INTVAL what) { - return PMCNULL; - } - - PMC* nextkey_keyed_int (INTVAL key, INTVAL what) { - return PMCNULL; - } - - PMC* nextkey_keyed_str (STRING *key, INTVAL what) { - return PMCNULL; - }*/ - -/* - -=item C - -=item C - -=item C - -=item C - -Remove and return the last element in the list according to internal ordering. -After removing the element, the internal pointer is reset to the first element. - -=cut - -*/ - FLOATVAL pop_float() { - PMC *p = SELF.pop_pmc(); - return VTABLE_get_number(INTERP, p); - } - - INTVAL pop_integer() { - PMC *p = SELF.pop_pmc(); - return VTABLE_get_integer(INTERP, p); - } - - PMC* pop_pmc() { - Bucket *new_tail; - struct bucket *tail; - HashTable *ht; - PMC *popped; - - if (ht->tableHead == NULL) { - return PMCNULL; - } - - ht = (HashTable*) PMC_struct_val(SELF); - if (ht->tableHead == ht->tableTail) { - popped = ht->tableHead->value; - mem_sys_free(ht->tableHead); - ht->internalPointer = NULL; - ht->tableHead = NULL; - ht->tableTail = NULL; - ht->elementCount = 0; - ht->nextIndex = 0; - } - else { - tail = ht->tableTail; - new_tail = ht->tableTail->tablePrev; - new_tail->tableNext = NULL; - ht->tableTail = new_tail; - ht->internalPointer = ht->tableHead; - popped = tail->value; - mem_sys_free(tail); - } - - return popped; - } - - STRING* pop_string() { - PMC *p = SELF.pop_pmc(); - return VTABLE_get_string(INTERP, p); - } - -/* - -=item C - -=item C - -=item C - -=item C - -Add C to the end of the PHPArray according to internal ordering. This -does B reset the internal pointer. - -=cut - -*/ - void push_float(FLOATVAL value) { - PMC *value_pmc = pmc_new(INTERP, enum_class_Float); - VTABLE_set_number_native(INTERP, value_pmc, value); - SELF.push_pmc(value_pmc); - } - - void push_integer(INTVAL value) { - PMC *value_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, value_pmc, value); - SELF.push_pmc(value_pmc); - } - - void push_pmc(PMC *value) { - HashTable *ht = (HashTable*)PMC_struct_val(SELF); - INTVAL key = ht->nextIndex; - ht->nextIndex++; - VTABLE_set_pmc_keyed_int(INTERP, SELF, key, value); - } - - void push_string(STRING *value) { - PMC *value_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, value_pmc, value); - SELF.push_pmc(value_pmc); - } -/* - -=item C - -=item C - -=item C - -=item C - -=item C - -=item C - -=item C - -=item C - -=item C - -=item C - -Associate C with C. - -=cut - -*/ - - void set_integer_keyed_int(INTVAL key, INTVAL value) { - PMC *key_pmc, *value_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - value_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, value_pmc, value); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND); - } - - void set_integer_keyed_str(STRING *key, INTVAL value) { - PMC *key_pmc, *value_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - value_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, value_pmc, value); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND); - } - - void set_integer_keyed(PMC *key, INTVAL value) { - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char *key_cstr; - char key_is_int; - - if (key == NULL) { - return; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("set_integer_keyed called with value = %d and key = %s\n", (int)value, key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("set_integer_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from set_integer_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - SELF.set_integer_keyed_int(index_i, value); - return; - } - else if (next_key == NULL && !key_is_int) { - SELF.set_integer_keyed_str(index_s, value); - return; - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == PMCNULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == PMCNULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_integer_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_set_integer_keyed(INTERP, box, next_key, value); - } - - void set_number_keyed_int(INTVAL key, FLOATVAL value) { - PMC *key_pmc, *value_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - value_pmc = pmc_new(INTERP, enum_class_Float); - VTABLE_set_number_native(INTERP, value_pmc, value); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND); - } - - void set_number_keyed_str(STRING *key, FLOATVAL value) { - PMC *key_pmc, *value_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - value_pmc = pmc_new(INTERP, enum_class_Float); - VTABLE_set_number_native(INTERP, value_pmc, value); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND); - } - - void set_number_keyed(PMC *key, FLOATVAL value) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char *key_cstr; - char key_is_int; - - if (key == NULL) { - return; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("set_number_keyed called with value = %d and key = %s\n", (int)value, key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("set_number_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from set_number_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - SELF.set_number_keyed_int(index_i, value); - return; - } - else if (next_key == NULL && !key_is_int) { - SELF.set_number_keyed_str(index_s, value); - return; - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == PMCNULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == PMCNULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_number_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_set_number_keyed(INTERP, box, next_key, value); - } - - void set_pmc_keyed_int(INTVAL key, PMC *value) { - PMC *key_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value, APPEND); - } - - void set_pmc_keyed_str(STRING *key, PMC *value) { - PMC *key_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value, APPEND); - } - - void set_pmc_keyed(PMC *key, PMC *value) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char *key_cstr; - char key_is_int; - - if (key == NULL) { - return; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - dprintf("set_pmc_keyed called with value = %d and key = %s\n", (int)value, key_cstr); - string_cstring_free(key_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("set_pmc_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_is_int = 0; - } - else { - dprintf("exception from set_pmc_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the aggregate PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - SELF.set_pmc_keyed_int(index_i, value); - return; - } - else if (next_key == NULL && !key_is_int) { - SELF.set_pmc_keyed_str(index_s, value); - return; - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == PMCNULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == PMCNULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_pmc_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_set_pmc_keyed(INTERP, box, next_key, value); - - } - - void set_string_keyed_int(INTVAL key, STRING *value) { - PMC *key_pmc, *value_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, key); - value_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, value_pmc, value); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND); - } - - void set_string_keyed_str(STRING *key, STRING *value) { - PMC *key_pmc, *value_pmc; - HashTable *ht; - - key_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, key_pmc, key); - value_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, value_pmc, value); - ht = (HashTable*) PMC_struct_val(SELF); - add_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND); - } - - void set_string_keyed(PMC *key, STRING *value) { - - PMC *box, *next_key; - INTVAL index_i, key_t, next_key_t; - STRING *index_s, *key_str; - char *key_cstr, *val_cstr; - char key_is_int; - - if (key == NULL) { - return; - } - else if (PMC_type(key) == enum_class_String) { - key = key_new_string(INTERP, VTABLE_get_string(INTERP, key)); - } - else if (PMC_type(key) == enum_class_Integer) { - key = key_new_integer(INTERP, VTABLE_get_integer(INTERP, key)); - } - - key_str = key_set_to_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, key_str); - val_cstr = string_to_cstring(INTERP, value); - dprintf("set_string_keyed called with value = '%s' and key = %s\n", val_cstr, key_cstr); - string_cstring_free(key_cstr); - string_cstring_free(val_cstr); - - key_t = key_type(INTERP, key); - - /*figure out type of the key*/ - if (key_t & KEY_integer_FLAG) { - index_i = key_integer(INTERP, key); - dprintf("set_string_keyed: integer index is %d\n", (int)index_i); - key_is_int = 1; - } - else if (key_t & KEY_string_FLAG) { - index_s = key_string(INTERP, key); - key_cstr = string_to_cstring(INTERP, index_s); - dprintf("set_string_keyed: string index is '%s'\n", key_cstr); - string_cstring_free(key_cstr); - key_is_int = 0; - } - else { - dprintf("exception from set_string_keyed, current key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - next_key = key_next(INTERP, key); - - /*if this is the PMC being requested...*/ - if (next_key == NULL && key_is_int) { - dprintf("retrieving value from index %d\n", (int)index_i); - SELF.set_string_keyed_int(index_i, value); - return; - } - else if (next_key == NULL && !key_is_int) { - SELF.set_string_keyed_str(index_s, value); - return; - } - - next_key_t = key_type(INTERP, next_key); - - if (key_t & KEY_integer_FLAG) { - dprintf("box has int key %d\n", (int)index_i); - box = SELF.get_pmc_keyed_int(index_i); - if (box == PMCNULL) { - dprintf("autovivifying box at int index %d\n", (int)index_i); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_int(index_i, box); - } - } - else if (key_t & KEY_string_FLAG) { - char *cstr = string_to_cstring(INTERP, index_s); - dprintf("box has string key %s\n", cstr); - box = SELF.get_pmc_keyed_str(index_s); - if (box == PMCNULL) { - dprintf("autovivifying box at string index %s\n", cstr); - box = pmc_new(INTERP, SELF.type()); - SELF.set_pmc_keyed_str(index_s, box); - } - string_cstring_free(cstr); - } - else { - dprintf("exception from set_integer_keyed, next key\n"); - real_exception(INTERP, NULL, E_KeyError, "must use integer or string keys"); - } - - return VTABLE_set_string_keyed(INTERP, box, next_key, value); - } -/* - -=item C - -Mark the PHPArray as shared and read-only. - -=cut - -*/ - - PMC* share_ro() { - return PMCNULL; - } - -/* - -=item C - -=item C - -=item C - -=item C - -Return the the first item on the list as the type specified, removing it from -this PHPArray. All remaining keys with numerical indicies are renumbered -according to their internal order in the PHPArray, starting from 0. After -shifting, the internal pointer is reset to the first element of the PHPArray. - -=cut - -*/ - FLOATVAL shift_float() { - PMC *p = SELF.shift_pmc(); - return VTABLE_get_number(INTERP, p); - } - - INTVAL shift_integer() { - PMC *p = SELF.shift_pmc(); - return VTABLE_get_integer(INTERP, p); - } - - PMC* shift_pmc() { - Bucket *new_head; - struct bucket *head; - HashTable *ht; - PMC *shifted; - char *str; - - if (ht->tableTail == NULL) { - return PMCNULL; - } - - ht = (HashTable*) PMC_struct_val(SELF); - if (ht->tableHead == ht->tableTail) { - shifted = ht->tableTail->value; - mem_sys_free(ht->tableTail); - ht->internalPointer = NULL; - ht->tableHead = NULL; - ht->tableTail = NULL; - ht->elementCount = 0; - ht->nextIndex = 0; - } - else { - head = ht->tableHead; - new_head = ht->tableHead->tableNext; - new_head->tablePrev = NULL; - ht->tableHead = new_head; - ht->internalPointer = ht->tableHead; - shifted = head->value; - mem_sys_free(head); - } - - return shifted; - } - - STRING* shift_string() { - PMC *p = SELF.shift_pmc(); - return VTABLE_get_string(INTERP, p); - } - -/* - PMC* slice (PMC *key, INTVAL flag) { - return PMCNULL; - } - - void splice (PMC *value, INTVAL offset, INTVAL count) { - - } */ - -/* - -=item C - -=item C - -=item C - -=item C - -Add the passed value to the beginning of this PHPArray. The value is given an -integer key of 0 and is placed first in the PHPArray's internal ordering. All -integer keys are renumbered starting from 0, according to their internal order -in the PHPArray. After unshifting, the internal pointer is reset to point to -the newly inserted element. - -=cut - -*/ - void unshift_float(FLOATVAL value) { - PMC *value_pmc = pmc_new(INTERP, enum_class_Float); - VTABLE_set_number_native(INTERP, value_pmc, value); - SELF.unshift_pmc(value_pmc); - } - - void unshift_integer(INTVAL value) { - PMC *value_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, value_pmc, value); - SELF.unshift_pmc(value_pmc); - } - - void unshift_pmc(PMC *value) { - - PMC *key_pmc; - HashTable *ht; - - ht = (HashTable*) PMC_struct_val(SELF); - - key_pmc = pmc_new(INTERP, enum_class_Integer); - VTABLE_set_integer_native(INTERP, key_pmc, ht->nextIndex); - - add_to_hashtable(INTERP, ht, key_pmc, value, PREPEND); - renumber_hash(INTERP, ht); - - ht->internalPointer = ht->tableHead; - } - - void unshift_string(STRING *value) { - PMC *value_pmc = pmc_new(INTERP, enum_class_String); - VTABLE_set_string_native(INTERP, value_pmc, value); - SELF.unshift_pmc(value_pmc); - } -/* - -=item C - -Used by freeze and thaw to visit the contents of the PMC. - -=item C - -Used to serialize this PHPArray. - - -=item C - -Used to unserialize this PHPArray. - -=cut - -*/ - - void visit(visit_info *info) { - } - - void freeze(visit_info *info) { - } - - void thaw(visit_info *info) { - } - -} - -/* - * Local variables: - * c-file-style: "parrot" - * End: - * vim: expandtab shiftwidth=4: - */ Index: languages/plumhead/t/pmc/array.t =================================================================== --- languages/plumhead/t/pmc/array.t (revision 26264) +++ languages/plumhead/t/pmc/array.t (working copy) @@ -1,507 +0,0 @@ -#! perl -# Copyright (C) 2008, The Perl Foundation. -# $Id$ - -=head1 NAME - -t/pmc/array.t - PHP array - -=head1 SYNOPSIS - - % perl -I../../lib t/pmc/array.t - -=head1 DESCRIPTION - -Tests C type -(implemented in F). - -=cut - -use strict; -use warnings; - -use Parrot::Test tests => 15; -use Test::More; - -pir_output_is( << 'CODE', << 'OUTPUT', 'unkeyed get_string' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc p1 - p1 = new 'PHPArray' - print p1 - print "\n" -.end -CODE -Array -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'int keyed set/get' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local int i1 - .local string s1 - - ar = new 'PHPArray' - - ar[1] = 2746 - i1 = ar[1] - print i1 - print "\n" -.end -CODE -2746 -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'int to string conversion' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local string s - - ar = new 'PHPArray' - - ar[1] = 'string' - - s = ar['1'] - print s - print "\n" -.end -CODE -string -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'string to int conversion' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local string s - - ar = new 'PHPArray' - - ar['1'] = 'right string' - - ar['01'] = 'wrong string' - s = ar[1] - print s - print "\n" -.end -CODE -right string -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'autovivification' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local int i1 - .local string s1 - - ar = new 'PHPArray' - - ar['this';1;'test';'will';'cause';6] = 'autovivifications' - s1 = ar['this';1;'test';'will';'cause';6] - print s1 - print "\n" -.end -CODE -autovivifications -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'string keyed set/get' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local int i1 - .local string s1 - - ar = new 'PHPArray' - - ar['x'] = 2746 - i1 = ar['x'] - print i1 - print "\n" -.end -CODE -2746 -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'several sets/gets' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local int i1 - .local string s1 - - ar = new 'PHPArray' - - ar[1] = 6 - ar[2] = 746 - ar[3] = 76 - ar[4] = 27 - ar[5] = 76 - ar[6] = 2 - ar[7] = 246 - ar[8] = 274 - ar[9] = 74 - i1 = ar[6] - print i1 - print "\n" -.end -CODE -2 -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'various types' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc a, pmc_str - .local int i - .local string s - .local num n - - a = new 'PHPArray' - pmc_str = new 'String' - pmc_str = 'This is a PMC string.' - - a[0] = 123 - a['not_pi'] = 3.142938 - a['string'] = 'normal string' - a[8] = pmc_str - - pmc_str = a[8] - print pmc_str - print "\n" - n = a['not_pi'] - print n - print "\n" - i = a[0] - print i - print "\n" - s = a['string'] - print s - print "\n" - -.end -CODE -This is a PMC string. -3.142938 -123 -normal string -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'push/pop' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local int i1 - .local string s1 - - ar = new 'PHPArray' - - push ar, 'foo' - push ar, 999 - push ar, 'bar' - s1 = pop ar - print s1 - s1 = pop ar - print s1 - s1 = pop ar - print s1 - print "\n" -.end -CODE -bar999foo -OUTPUT - - -pir_output_is( << 'CODE', << 'OUTPUT', 'unshift/shift' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc ar, pmc_str - .local int i1 - .local string s1 - - ar = new 'PHPArray' - - unshift ar, 'foo' - s1 = shift ar - print s1 - print "\n" -.end -CODE -foo -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'exists' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc a - .local int i - - a = new 'PHPArray' - - a[1;2;'three';'exists'] = 'exists' - - i = exists a[1;2;'three';'exists'] - print i - print "\n" - - i = exists a['does';'not';'exist'] - print i - print "\n" - -.end -CODE -1 -0 -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'delete' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc a - .local int i1, i2 - - a = new 'PHPArray' - - delete a['foo'] - - delete a[3;'bar';'baz'] - - a[1;'two'] = 'buckle my shoe' - a['three';4] = 'knock at the door' - - delete a[1] - i1 = exists a[1;'two'] - i2 = exists a[1] - print i1 - print ',' - print i2 - print "\n" - - delete a['three';4] - i1 = exists a['three';4] - i2 = exists a['three'] - print i1 - print ',' - print i2 - print "\n" - -.end -CODE -0,0 -0,1 -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'iterator' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc iter, p, val - - p = new 'PHPArray' - - p['FOO'] = 'The ' - p[25] = 'iterator ' - p[0] = 'is ' - p[-87] = 'doing ' - p['BUZ'] = 'the ' - p['x'] = 'right ' - p[1] = "thing.\n" - - iter = new 'Iterator', p - -iter_loop: - unless iter, iter_end - val = shift iter - val = p[val] - print val - goto iter_loop -iter_end: - -.end -CODE -The iterator is doing the right thing. -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'cmp - shallow tests' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc p1, p2 - .local int i - - p1 = new 'PHPArray' - p2 = new 'PHPArray' - - i = cmp p1, p2 - print "test 0:" - print i - print "\n" - - p1['Foo'] = 'bar' - p1[224] = 'quux' - p1['box'] = 3882 - p1[828] = 894 - - p2[828] = 894 - p2['box'] = 3882 - p2[224] = 'quux' - p2['Foo'] = 'bar' - - i = cmp p1, p2 - print "test 1:" - print i - print "\n" - - p1[828] = 'bub' - - i = cmp p1, p2 - print "test 2:" - print i - print "\n" - - p2['xxx'] = 0 - - i = cmp p1, p2 - print "test 3:" - print i - print "\n" - -.end -CODE -test 0:0 -test 1:0 -test 2:1 -test 3:-1 -OUTPUT - -pir_output_is( << 'CODE', << 'OUTPUT', 'cmp - deep tests' ); -.HLL 'PHP', 'php_group' -.sub _main - .local pmc p1, p1a, p1b - .local pmc p2, p2a, p2b, p2c - .local int i - - p1 = new 'PHPArray' - p1a = new 'PHPArray' - p1b = new 'PHPArray' - - p2 = new 'PHPArray' - p2a = new 'PHPArray' - p2b = new 'PHPArray' - p2c = new 'PHPArray' - - p1['a'] = p1a - p1['b'] = p1b - - p2['a'] = p2a - p2['b'] = p2b - - i = cmp p1, p2 - print "test 0:" - print i - print "\n" - - p1['fooo'] = 0 - p2['fooo'] = 0 - - p1['a';'box'] = 9 - p1['b';8] = 123 - p1['b';9] = 'mismatch' - p2['a';'box'] = 9 - p2['b';8] = 123 - - i = cmp p1, p2 - print "test 1:" - print i - print "\n" - - p2['b';9] = 'mismatch' - - i = cmp p1, p2 - print "test 2:" - print i - print "\n" - - p2['c'] = p2c - p1['c'] = 'o' - - i = cmp p1, p2 - print "test 3:" - print i - print "\n" - -.end -CODE -test 0:0 -test 1:1 -test 2:0 -test 3:1 -OUTPUT - -#pir_output_is( << 'CODE', << 'OUTPUT', 'add' ); -#.HLL 'PHP', 'php_group' -#.sub _main -# .local pmc p1, p2, p3 -# -# p1 = new 'PHPArray' -# p2 = new 'PHPArray' -# p3 = new 'PHPArray' -# -# p1[0] = 'It ' -# p1[1] = 'looks ' -# p2[2] = 'like' -# p2[3] = ' add ' -# p1[4] = 'is working.\n' -# p2[4] = 'is broken.\n' -# -# p3 = p1 + p2 -# -# print p3[0] -# print p3[1] -# print p3[2] -# print p3[3] -# print p3[4] -# -#.end -#CODE -#It looks like add is working. -#OUTPUT -# -# -#pir_output_is( << 'CODE', << 'OUTPUT', 'i_add' ); -#.HLL 'PHP', 'php_group' -#.sub _main -# .local pmc p1, p2 -# -# p1 = new 'PHPArray' -# p2 = new 'PHPArray' -# -# p1[0] = 'It ' -# p1[1] = 'looks ' -# p2[2] = 'like' -# p2[3] = ' i_add ' -# p1[4] = "is working.\n" -# p2[4] = "is broken.\n" -# -# p1 += p2 -# -# print p1[0] -# print p1[1] -# print p1[2] -# print p1[3] -# print p1[4] -# -#.end -#CODE -#It looks like i_add is working. -#OUTPUT - - -# Local Variables: -# mode: cperl -# cperl-indent-level: 4 -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4: - Index: languages/plumhead/config/makefiles/root.in =================================================================== --- languages/plumhead/config/makefiles/root.in (revision 26264) +++ languages/plumhead/config/makefiles/root.in (working copy) @@ -8,24 +8,14 @@ PERL = @perl@ RM_F = @rm_f@ RECONFIGURE = $(PERL) @build_dir@/tools/dev/reconfigure.pl -PMCBUILD = $(PERL) @build_dir@/tools/build/dynpmc.pl # Set up directories BUILD_DIR = @build_dir@ TGE_DIR = ../../compilers/tge LIBRARY_DIR = @build_dir@/runtime/parrot/library -PMC_DIR = pmc PARROT_DYNEXT = @build_dir@/runtime/parrot/dynext -# Set up PMCs -PMCS = \ - phparray - -PMC_FILES = \ - $(PMC_DIR)/phparray.pmc - - # default all: build @@ -45,7 +35,6 @@ @echo " Current this has nothing to do." @echo " build-antlr3 Build support for variant 'Plumhead antlr3'." @echo " Needs javac and a proper CLASSPATH." - @echo " pmc Build only the PMCs." @echo "" @echo "Testing:" @echo " test: Run the test suite for 'Plumhead pct'." @@ -54,7 +43,6 @@ @echo " test-phc: Run the test suite for 'Plumhead phc'." @echo " test-antlr3: Run the test suite for 'Plumhead antlr3'." @echo " test-pct: Run the test suite for 'Plumhead pct'." - @echo " pmc-test: Test the PMCs." @echo "" @echo "Cleaning:" @echo " clean: Clean up." @@ -81,7 +69,7 @@ java org.antlr.Tool src/antlr3/Plumhead.g java org.antlr.Tool -lib src/antlr3 src/antlr3/GenPastPir.g -build: pmc build-pct +build: build-pct build-all: build-pct build-phc build-antlr3 @@ -93,19 +81,8 @@ build-antlr3: build-common @echo 'Be sure to have set CLASSPATH as laid out in docs/antlr3.pod' - javac src/antlr3/*.java + javac src/antlr3/*.java -pmc : pmc/php_group$(LOAD_EXT) - -pmc/php_group$(LOAD_EXT) : $(PMC_FILES) - @cd $(PMC_DIR) && $(PMCBUILD) generate $(PMCS) - @cd $(PMC_DIR) && $(PMCBUILD) compile $(PMCS) - @cd $(PMC_DIR) && $(PMCBUILD) linklibs $(PMCS) - @cd $(PMC_DIR) && $(PMCBUILD) copy "--destination=$(PARROT_DYNEXT)" $(PMCS) - -pmc-test : pmc - $(PERL) -I../../lib t/pmc/array.t - src/common/plumheadlib.pbc: src/common/builtins.pir $(PARROT) -o src/common/plumheadlib.pbc src/common/builtins.pir @@ -140,7 +117,7 @@ test-pct: - cd .. && $(PERL) -I../lib -I plumhead/lib plumhead/t/harness --with-pct -clean: clean-common clean-pct clean-antlr3 clean-test clean-pmc +clean: clean-common clean-pct clean-antlr3 clean-test clean-common: $(RM_F) src/common/plumheadlib.pbc plumhead.pbc @@ -154,8 +131,5 @@ clean-test: $(RM_F) t/php/*.php t/php/*.pir t/php/*.out t/pmc/*.pir -clean-pmc: - $(RM_F) pmc/*.c pmc/*.h pmc/*.o pmc/*.so pmc/*.dump - realclean: clean $(RM_F) Makefile