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

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

From:
infinoid
Date:
January 7, 2009 22:53
Subject:
[svn:parrot] r35193 - in trunk: src/pmc t/pmc
Message ID:
20090108065334.00E75CB9F9@x12.develooper.com
Author: infinoid
Date: Wed Jan  7 22:53:33 2009
New Revision: 35193

Modified:
   trunk/src/pmc/packfile.pmc
   trunk/src/pmc/packfiledirectory.pmc
   trunk/src/pmc/packfilesegment.pmc
   trunk/t/pmc/packfile.t

Log:
[pdd13] Implement PackfileDirectory.get_pmc_keyed_str (fetch segment by name)

Modified: trunk/src/pmc/packfile.pmc
==============================================================================
--- trunk/src/pmc/packfile.pmc	(original)
+++ trunk/src/pmc/packfile.pmc	Wed Jan  7 22:53:33 2009
@@ -68,12 +68,8 @@
         opcode_t *ptr = (opcode_t*)mem_sys_allocate(length);
         STRING *str;
         PackFile_pack(interp, pf, ptr);
-        /* FIXME: PARROT_BINARY_CHARSET seems like a better choice, but the
-         * comparison function for the binary charset plugin always returns
-         * "equal", which means tests fail.
-         */
         str = string_make_direct(interp, (const char*)ptr, length,
-                PARROT_FIXED_8_ENCODING, PARROT_DEFAULT_CHARSET, 0);
+                PARROT_FIXED_8_ENCODING, PARROT_BINARY_CHARSET, 0);
         mem_sys_free(ptr);
         return str;
     }

Modified: trunk/src/pmc/packfiledirectory.pmc
==============================================================================
--- trunk/src/pmc/packfiledirectory.pmc	(original)
+++ trunk/src/pmc/packfiledirectory.pmc	Wed Jan  7 22:53:33 2009
@@ -116,7 +116,16 @@
 
 */
     VTABLE PMC *get_pmc_keyed_str(STRING *name)  {
-        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED, "Not implemented yet.");
+        PackFile_Directory *pfd = PMC_data_typed(SELF, PackFile_Directory *);
+        int i, total = pfd->num_segments;
+        for (i = 0; i < total; i++) {
+            PackFile_Segment *pfseg;
+            pfseg = pfd->segments[i];
+            if (!string_compare(interp, name, const_string(interp, pfseg->name)))
+                return VTABLE_get_pmc_keyed_int(interp, SELF, i);
+        }
+        /* the specified segment name wasn't found. */
+        return PMCNULL;
     }
 
 

Modified: trunk/src/pmc/packfilesegment.pmc
==============================================================================
--- trunk/src/pmc/packfilesegment.pmc	(original)
+++ trunk/src/pmc/packfilesegment.pmc	Wed Jan  7 22:53:33 2009
@@ -57,13 +57,9 @@
         opcode_t *newptr, *ptr = (opcode_t*)mem_sys_allocate(length);
         STRING *str;
         newptr = PackFile_Segment_pack(interp, pfseg, ptr);
-        /* FIXME: PARROT_BINARY_CHARSET seems like a better choice, but the
-         * comparison function for the binary charset plugin always returns
-         * "equal", which means tests fail.
-         */
         str = string_make_direct(interp, (const char*)ptr,
                 (newptr - ptr) * sizeof (opcode_t),
-                PARROT_FIXED_8_ENCODING, PARROT_DEFAULT_CHARSET, 0);
+                PARROT_FIXED_8_ENCODING, PARROT_BINARY_CHARSET, 0);
         mem_sys_free(ptr);
         RETURN(STRING *str);
     }

Modified: trunk/t/pmc/packfile.t
==============================================================================
--- trunk/t/pmc/packfile.t	(original)
+++ trunk/t/pmc/packfile.t	Wed Jan  7 22:53:33 2009
@@ -69,6 +69,8 @@
 OUT
 
 
+# common setup code for later tests
+
 my $get_uuid_pbc = <<'EOF';
 
 .sub _pbc
@@ -231,7 +233,7 @@
 
 # PackfileDirectory.get_pmc_keyed_str
 
-pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'PackfileDirectory.get_pmc_keyed_str', todo => 'implement this' );
+pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'PackfileDirectory.get_pmc_keyed_str' );
 .sub 'test' :main
     .local pmc pf, pfdir
     pf    = _pbc()
@@ -239,11 +241,11 @@
     $I0   = elements pfdir
     $I1   = 0
     LOOP:
-    $P0   = pfdir[$I1]
-    $S1   = pfdir[$I1]
-    $P1   = pfdir[$S1]
-    $S0 = $P0
-    $S1 = $P1
+    $P0 = pfdir[$I1]
+    $S1 = pfdir[$I1]
+    $P1 = pfdir[$S1]
+    $S0 = typeof $P0
+    $S1 = typeof $P1
     eq $S0, $S1, GOOD
     goto ERROR
     GOOD:



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