Author: infinoid
Date: Thu Jan 8 20:37:45 2009
New Revision: 35238
Added:
trunk/t/pmc/packfileconstanttable.t
Modified:
trunk/src/pmc/packfileconstanttable.pmc
Log:
[pdd13] Implement and test PackfileConstantTable methods.
Modified: trunk/src/pmc/packfileconstanttable.pmc
==============================================================================
--- trunk/src/pmc/packfileconstanttable.pmc (original)
+++ trunk/src/pmc/packfileconstanttable.pmc Thu Jan 8 20:37:45 2009
@@ -26,6 +26,21 @@
#include "parrot/parrot.h"
+static PackFile_Constant *
+getconst(PARROT_INTERP, PackFile_ConstTable *table, int index, int type)
+{
+ PackFile_Constant *rv;
+ if(index < 0 || index >= table->const_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
+ "Requested data out of range.");
+ rv = table->constants[index];
+ if(rv->type != type)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Requested constant of the wrong type.");
+ return rv;
+}
+
+
pmclass PackfileConstantTable extends PackfileSegment {
@@ -39,7 +54,8 @@
*/
VTABLE INTVAL elements() {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Not implemented yet.");
+ PackFile_ConstTable *pftable = PMC_data_typed(SELF,
PackFile_ConstTable *);
+ return pftable->const_count;
}
@@ -54,7 +70,9 @@
*/
VTABLE FLOATVAL get_number_keyed_int(INTVAL index) {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Not implemented yet.");
+ PackFile_ConstTable *pftable = PMC_data_typed(SELF,
PackFile_ConstTable *);
+ PackFile_Constant *constant = getconst(interp, pftable, index,
PFC_NUMBER);
+ return constant->u.number;
}
@@ -69,7 +87,9 @@
*/
VTABLE STRING *get_string_keyed_int(INTVAL index) {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Not implemented yet.");
+ PackFile_ConstTable *pftable = PMC_data_typed(SELF,
PackFile_ConstTable *);
+ PackFile_Constant *constant = getconst(interp, pftable, index,
PFC_STRING);
+ return constant->u.string;
}
@@ -83,7 +103,9 @@
*/
VTABLE PMC *get_pmc_keyed_int(INTVAL index) {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Not implemented yet.");
+ PackFile_ConstTable *pftable = PMC_data_typed(SELF,
PackFile_ConstTable *);
+ PackFile_Constant *constant = getconst(interp, pftable, index,
PFC_PMC);
+ return constant->u.key;
}
@@ -152,8 +174,16 @@
=cut
*/
- INTVAL get_type(INTVAL index) {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Not implemented yet.");
+ METHOD get_type(INTVAL index) {
+ PackFile_ConstTable *pftable = PMC_data_typed(SELF,
PackFile_ConstTable *);
+ PackFile_Constant *constant;
+ INTVAL rv;
+ if(index < 0 || index >= pftable->const_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
+ "Requested data out of range.");
+ constant = pftable->constants[index];
+ rv = constant->type;
+ RETURN(INTVAL rv);
}
Added: trunk/t/pmc/packfileconstanttable.t
==============================================================================
--- (empty file)
+++ trunk/t/pmc/packfileconstanttable.t Thu Jan 8 20:37:45 2009
@@ -0,0 +1,128 @@
+#!perl
+# Copyright (C) 2009, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+use Test::More;
+use Parrot::Test tests => 2;
+use Parrot::Config;
+
+=head1 NAME
+
+t/pmc/packfileconstanttable.t - test the PackfileConstantTable PMC
+
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/packfileconstanttable.t
+
+=head1 DESCRIPTION
+
+Tests the PackfileConstantTable PMC.
+
+=cut
+
+# Having some known data would be helpful, here. For now, just make sure
+# the values returned from get_type look right, and that the corresponding
+# fetches for the found types don't crash.
+
+
+# common setup code for later tests
+
+my $get_uuid_pbc = <<'EOF';
+
+.sub _pbc
+ .include "stat.pasm"
+ .include "interpinfo.pasm"
+ .local pmc pf, pio
+ pf = new 'Packfile'
+ $S0 = interpinfo .INTERPINFO_RUNTIME_PREFIX
+ $S0 .= "/runtime/parrot/library/uuid.pbc"
+ $I0 = stat $S0, .STAT_FILESIZE
+ pio = open $S0, 'r'
+ $S0 = read pio, $I0
+ close pio
+ pf = $S0
+ .return(pf)
+.end
+EOF
+
+
+# PackfileConstantTable.elements
+
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'elements' );
+.sub 'test' :main
+ .local pmc pf, pfdir, pftable
+ .local int size
+ pf = _pbc()
+ pfdir = pf.'get_directory'()
+ pftable = pfdir[2]
+ size = elements pftable
+ gt size, 0, DONE
+ say 'not '
+ DONE:
+ say 'greater'
+.end
+CODE
+greater
+OUT
+
+
+# PackfileRawSegment.get_integer_keyed_int
+
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'get_integer_keyed_int' );
+.sub 'test' :main
+ .local pmc pf, pfdir, pftable
+ .local int size, this, type
+ pf = _pbc()
+ pfdir = pf.'get_directory'()
+ pftable = pfdir[2]
+ size = elements pftable
+ this = 0
+ LOOP:
+ type = pftable.'get_type'(this)
+ eq type, 0x00, NEXT
+ eq type, 0x6E, CONST_NUM
+ eq type, 0x73, CONST_STR
+ eq type, 0x70, CONST_PMC
+ eq type, 0x6B, CONST_KEY
+ goto BAD
+ CONST_NUM:
+ $N0 = pftable[this]
+ goto NEXT
+ CONST_STR:
+ $S0 = pftable[this]
+ goto NEXT
+ CONST_PMC:
+ $P0 = pftable[this]
+ goto NEXT
+ CONST_KEY:
+ $P0 = pftable[this]
+ $S0 = typeof $P0
+ eq $S0, 'Key', NEXT
+ print 'constant Key with wrong type: '
+ say $S0
+ goto BAD
+ NEXT:
+ this = this + 1
+ ge this, size, DONE
+ goto LOOP
+ gt size, 0, DONE
+ BAD:
+ say 'unknown constant type found!'
+ DONE:
+ say 'done.'
+.end
+CODE
+done.
+OUT
+
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
