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

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

From:
infinoid
Date:
January 14, 2009 18:30
Subject:
[svn:parrot] r35573 - in trunk: src/pmc t/pmc
Message ID:
20090115022939.240E8CB9AE@x12.develooper.com
Author: infinoid
Date: Wed Jan 14 18:29:30 2009
New Revision: 35573

Added:
   trunk/t/pmc/packfilefixuptable.t
Modified:
   trunk/src/pmc/packfilefixuptable.pmc

Log:
[pdd13] Implement and test the readonly portions of PackfileFixupTable.

Modified: trunk/src/pmc/packfilefixuptable.pmc
==============================================================================
--- trunk/src/pmc/packfilefixuptable.pmc	(original)
+++ trunk/src/pmc/packfilefixuptable.pmc	Wed Jan 14 18:29:30 2009
@@ -39,7 +39,8 @@
 
 */
     VTABLE INTVAL elements() {
-        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED, "Not implemented yet.");
+        PackFile_FixupTable *pftable = PMC_data_typed(SELF, PackFile_FixupTable *);
+        return pftable->fixup_count;
     }
 
 
@@ -53,7 +54,14 @@
 
 */
     VTABLE PMC *get_pmc_keyed_int(INTVAL index)  {
-        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED, "Not implemented yet.");
+        PackFile_FixupTable *pftable = PMC_data_typed(SELF, PackFile_FixupTable *);
+        PMC *rv;
+        if (index < 0 || index >= pftable->fixup_count)
+            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
+                    "Requested data out of range.");
+        rv = pmc_new(interp, enum_class_PackfileFixupEntry);
+        PMC_data(rv) = pftable->fixups[index];
+        return rv;
     }
 
 

Added: trunk/t/pmc/packfilefixuptable.t
==============================================================================
--- (empty file)
+++ trunk/t/pmc/packfilefixuptable.t	Wed Jan 14 18:29:30 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 => 3;
+use Parrot::Config;
+
+=head1 NAME
+
+t/pmc/packfilefixuptable.t - test the PackfileFixupTable PMC
+
+
+=head1 SYNOPSIS
+
+    % prove t/pmc/packfilefixuptable.t
+
+=head1 DESCRIPTION
+
+Tests the PackfileFixupTable PMC.
+
+=cut
+
+# Having some known data would be helpful, here.  For now, just make sure
+# the values returned have the right types.
+
+
+# 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
+
+
+# sanity check we have a PackfileFixupTable
+
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'sanity' );
+.sub 'test' :main
+    .local pmc pf, pfdir, pftable
+    .local string name
+    pf      = _pbc()
+    pfdir   = pf.'get_directory'()
+    pftable = pfdir[1]
+    name    = typeof pftable
+    say name
+.end
+CODE
+PackfileFixupTable
+OUT
+
+
+# PackfileFixupTable.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[1]
+    size    = elements pftable
+    gt size, 0, DONE
+    say 'not '
+    DONE:
+    say 'greater'
+.end
+CODE
+greater
+OUT
+
+
+# PackfileFixupTable.get_pmc_keyed_int
+
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'get_pmc_keyed_int' );
+.sub 'test' :main
+    .local pmc pf, pfdir, pftable, pfentry
+    .local int size, this
+    .local string type
+    pf      = _pbc()
+    pfdir   = pf.'get_directory'()
+    pftable = pfdir[1]
+    size    = elements pftable
+    this    = 0
+    LOOP:
+    pfentry = pftable[this]
+    type    = typeof pfentry
+    eq type, "PackfileFixupEntry", NEXT
+    print "PackfileFixupTable["
+    print this
+    print "] returned an object of type: "
+    say type
+    goto DONE
+    NEXT:
+    this = this + 1
+    ge this, size, DONE
+    goto LOOP
+    gt size, 0, DONE
+    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