develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35238 - in trunk: src/pmc t/pmc

From:
infinoid
Date:
January 8, 2009 20:37
Subject:
[svn:parrot] r35238 - in trunk: src/pmc t/pmc
Message ID:
20090109043746.2071DCB9F9@x12.develooper.com
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:



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About