[svn:parrot] r29652 - in branches/pdd13pbc: src/pmc t/pmc

[infinoid]

Author: infinoid
Date: Mon Jul 21 06:10:47 2008
New Revision: 29652

Modified:
   branches/pdd13pbc/src/pmc/packfiledirectory.pmc
   branches/pdd13pbc/t/pmc/packfile.t

Log:
[PDD13]
* Implement the following PackfileDirectory methods:
  - elements
  - get_pmc_keyed_int
  - get_string_keyed_int
* Test basic enumeration of PBC segments from PIR.


Modified: branches/pdd13pbc/src/pmc/packfiledirectory.pmc
==============================================================================
--- branches/pdd13pbc/src/pmc/packfiledirectory.pmc     (original)
+++ branches/pdd13pbc/src/pmc/packfiledirectory.pmc     Mon Jul 21 06:10:47 2008
@@ -40,7 +40,8 @@
 
 */
     VTABLE INTVAL elements() {
-        real_exception(interp, NULL, E_NotImplementedError, "Not implemented 
yet.");
+        PackFile_Directory *pfd = PMC_data_typed(SELF, PackFile_Directory *);
+        return pfd->num_segments;
     }
 
 
@@ -54,7 +55,32 @@
 
 */
     VTABLE PMC *get_pmc_keyed_int(INTVAL index)  {
-        real_exception(interp, NULL, E_NotImplementedError, "Not implemented 
yet.");
+        PackFile_Directory *pfd = PMC_data_typed(SELF, PackFile_Directory *);
+        PackFile_Segment *pfseg;
+        PMC *rv;
+        int pmc_type;
+        if(index < 0 || index >= (INTVAL)pfd->num_segments)
+            return PMCNULL;
+        pfseg = pfd->segments[index];
+        switch(pfseg->type) {
+            case PF_DIR_SEG:
+                pmc_type = enum_class_PackfileDirectory;
+                break;
+            case PF_FIXUP_SEG:
+                pmc_type = enum_class_PackfileFixupTable;
+                break;
+            case PF_CONST_SEG:
+                pmc_type = enum_class_PackfileConstantTable;
+                break;
+            case PF_BYTEC_SEG:
+            case PF_UNKNOWN_SEG:
+            case PF_DEBUG_SEG:
+            default:
+                pmc_type = enum_class_PackfileRawSegment;
+        }
+        rv = pmc_new(interp, pmc_type);
+        PMC_data(rv) = pfseg;
+        return rv;
     }
 
 
@@ -68,7 +94,14 @@
 
 */
     VTABLE STRING *get_string_keyed_int(INTVAL index)  {
-        real_exception(interp, NULL, E_NotImplementedError, "Not implemented 
yet.");
+        PackFile_Directory *pfd = PMC_data_typed(SELF, PackFile_Directory *);
+        PackFile_Segment *pfseg;
+        PMC *rv;
+        int pmc_type;
+        if(index < 0 || index >= (INTVAL)pfd->num_segments)
+            return PMCNULL;
+        pfseg = pfd->segments[index];
+        return const_string(interp, pfseg->name);
     }
 
 

Modified: branches/pdd13pbc/t/pmc/packfile.t
==============================================================================
--- branches/pdd13pbc/t/pmc/packfile.t  (original)
+++ branches/pdd13pbc/t/pmc/packfile.t  Mon Jul 21 06:10:47 2008
@@ -6,7 +6,7 @@
 use warnings;
 use lib qw( . lib ../lib ../../lib );
 use Test::More;
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 8;
 use Parrot::Config;
 
 =head1 NAME
@@ -154,6 +154,51 @@
 OUT
 
 
+# PackfileDirectory.elements
+
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'set_integer_keyed_str' );
+.sub 'test' :main
+    .local pmc pf, pfdir
+    pf    = _pbc()
+    pfdir = pf.'get_directory'()
+    $I0   = elements pfdir
+    eq $I0, 0, OUT1
+    print "not "
+    OUT1:
+    say "equal"
+.end
+CODE
+not equal
+OUT
+
+
+# PackfileDirectory.get_pmc_keyed_int
+
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'set_integer_keyed_str' );
+.sub 'test' :main
+    .local pmc pf, pfdir
+    pf    = _pbc()
+    pfdir = pf.'get_directory'()
+    $I0   = elements pfdir
+    $I1   = 0
+    LOOP:
+    $P0   = pfdir[$I1]
+    $I2   = defined $P0
+    eq $I2, 0, ERROR
+    inc $I1
+    eq $I0, $I1, DONE
+    goto LOOP
+    DONE:
+    say "done"
+    .return()
+    ERROR:
+    say "error"
+.end
+CODE
+done
+OUT
+
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4