[svn:parrot] r37962 - branches/packfile_revamp/t/pmc
bacek at svn.parrot.org
bacek at svn.parrot.org
Tue Apr 7 21:36:44 UTC 2009
Author: bacek
Date: Tue Apr 7 21:36:43 2009
New Revision: 37962
URL: https://trac.parrot.org/parrot/changeset/37962
Log:
Rewrite t/pmc/packfiledirectory.t in PIR
Modified:
branches/packfile_revamp/t/pmc/packfiledirectory.t
Modified: branches/packfile_revamp/t/pmc/packfiledirectory.t
==============================================================================
--- branches/packfile_revamp/t/pmc/packfiledirectory.t Tue Apr 7 21:36:02 2009 (r37961)
+++ branches/packfile_revamp/t/pmc/packfiledirectory.t Tue Apr 7 21:36:43 2009 (r37962)
@@ -1,14 +1,7 @@
-#!perl
+#! parrot
# Copyright (C) 2009, Parrot Foundation.
# $Id$
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 6;
-use Parrot::Config;
-
=head1 NAME
t/pmc/packfiledirectory.t - test the PackfileDirectory PMC
@@ -24,170 +17,173 @@
=cut
+.sub 'main' :main
+.include 'test_more.pir'
+ plan(14)
+
+ 'test_typeof'()
+ 'test_elements'()
+ 'test_get_pmc_keyed_int'()
+ 'test_get_string_keyed_int'()
+ 'test_get_pmc_keyed_str'()
+ 'test_set_pmc_keyed_str'()
+.end
# PackfileDirectory.typeof
-
-pir_output_is( <<'CODE', <<'OUT', 'get_directory' );
-.sub 'test' :main
+.sub 'test_typeof'
.local pmc pf
pf = new ['Packfile']
$P1 = pf.'get_directory'()
$S0 = typeof $P1
- say $S0
+ $I0 = cmp $S0, 'PackfileDirectory'
+ $I0 = not $I0
+ ok($I0, 'PackfileDirectory.get_directory')
.end
-CODE
-PackfileDirectory
-OUT
-
-
-# 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
# PackfileDirectory.elements
-
-pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'PackfileDirectory.elements' );
-.sub 'test' :main
+.sub 'test_elements'
.local pmc pf, pfdir
pf = _pbc()
pfdir = pf.'get_directory'()
$I0 = elements pfdir
- say $I0
+ $I0 = 5 == $I0
+ ok($I0, 'PackfileDirectory.elements')
.end
-CODE
-5
-OUT
# PackfileDirectory.get_pmc_keyed_int
-
-pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'PackfileDirectory.get_pmc_keyed_int' );
-.sub 'test' :main
+.sub 'test_get_pmc_keyed_int'
.local pmc pf, pfdir
pf = _pbc()
pfdir = pf.'get_directory'()
$I0 = elements pfdir
$I1 = 0
- LOOP:
+ loop:
$P0 = pfdir[$I1]
$I2 = defined $P0
- eq $I2, 0, ERROR
+ ok($I2, 'PackfileDirectory.get_pmc_keyed_int')
inc $I1
- eq $I0, $I1, DONE
- goto LOOP
- DONE:
- say "done"
- .return()
- ERROR:
- say "error"
+ eq $I0, $I1, done
+ goto loop
+ done:
+ .return ()
.end
-CODE
-done
-OUT
-
-
-# PackfileDirectory.get_string_keyed_int
-my $EXPECTED = <<EXPECTED;
-BYTECODE_runtime/parrot/library/uuid.pir
-FIXUP_runtime/parrot/library/uuid.pir
-CONSTANT_runtime/parrot/library/uuid.pir
-PIC_idx_runtime/parrot/library/uuid.pir
-BYTECODE_runtime/parrot/library/uuid.pir_DB
-EXPECTED
-$EXPECTED =~ s/\//\\/g
- if $^O eq 'MSWin32';
-
-pir_output_is( <<'CODE' . $get_uuid_pbc, $EXPECTED, 'PackfileDirectory.get_string_keyed_int' );
-.sub 'test' :main
+## PackfileDirectory.get_string_keyed_int
+.sub 'test_get_string_keyed_int'
.local pmc pf, pfdir
+ .local pmc expected
+ expected = new 'ResizableStringArray'
+ push expected, 'BYTECODE'
+ push expected, 'FIXUP'
+ push expected, 'CONSTANT'
+ push expected, 'PIC'
+ push expected, 'BYTECODE'
+
pf = _pbc()
pfdir = pf.'get_directory'()
$I0 = elements pfdir
$I1 = 0
- LOOP:
+ loop:
$S0 = pfdir[$I1]
- say $S0
+ $P0 = split '_', $S0
+ $S0 = shift $P0
+ $S1 = shift expected
+ $I3 = cmp $S0, $S1
+ $I3 = not $I3
+ ok($I3, 'PackfileDirectory.get_string_keyed_int')
inc $I1
- eq $I0, $I1, DONE
- goto LOOP
- DONE:
+ eq $I0, $I1, done
+ goto loop
+ done:
.return()
.end
-CODE
-# PackfileDirectory.get_pmc_keyed_str
-
-pir_output_is( <<'CODE' . $get_uuid_pbc, <<'OUT', 'PackfileDirectory.get_pmc_keyed_str' );
-.sub 'test' :main
+## PackfileDirectory.get_pmc_keyed_str
+.sub 'test_get_pmc_keyed_str'
.local pmc pf, pfdir
pf = _pbc()
pfdir = pf.'get_directory'()
$I0 = elements pfdir
$I1 = 0
- LOOP:
+ loop:
$P0 = pfdir[$I1]
$S1 = pfdir[$I1]
$P1 = pfdir[$S1]
$S0 = typeof $P0
$S1 = typeof $P1
- eq $S0, $S1, GOOD
- goto ERROR
- GOOD:
+ eq $S0, $S1, good
+ goto error
+ good:
inc $I1
- eq $I0, $I1, DONE
- goto LOOP
- DONE:
- say 'good'
+ eq $I0, $I1, done
+ goto loop
+ done:
+ ok(1, 'PackfileDirectory.get_pmc_keyed_int')
.return()
- ERROR:
- say 'mismatch'
+ error:
+ ok(0, 'PackfileDirectory.get_pmc_keyed_int')
.end
-CODE
-good
-OUT
-# PackfileDirectory.set_pmc_keyed_str
-my $EXPECTED_foo = $EXPECTED . "BYTECODE_foo\n";
-pir_output_is( <<'CODE' . $get_uuid_pbc, $EXPECTED_foo, 'PackfileDirectory.set_pmc_keyed_str' );
-.sub 'test' :main
+## PackfileDirectory.set_pmc_keyed_str
+.sub 'test_set_pmc_keyed_str'
.local pmc pf, pfdir
pf = _pbc()
pfdir = pf.'get_directory'()
$P0 = new [ 'PackfileRawSegment' ]
- $S0 = 'BYTECODE_foo'
+
+ # We've got some bug during replacing old Segment
+ goto add_new
+
+ # Adding segment with same name replaces old one
+ $I0 = elements pfdir
+ $S0 = pfdir[0]
pfdir[$S0] = $P0
- $I0 = elements pfdir
- $I1 = 0
- LOOP:
- $S0 = pfdir[$I1]
- say $S0
- inc $I1
- eq $I0, $I1, DONE
- goto LOOP
- DONE:
+ $I1 = elements pfdir
+ if $I0 == $I1 goto add_new
+ ok(0, "Segment with old name was added")
+ goto done
+
+ # Add segment with new name
+ add_new:
+ $P0 = new [ 'PackfileRawSegment' ]
+ $S0 = 'BYTECODE_foo'
+ pfdir[$S0] = $P0
+ $I1 = elements pfdir
+ $I3 = $I0 != $I1
+ ok($I3, "New segment added")
+
+ done:
.return()
.end
-CODE
+
+# Return test filename
+# Currently parrot doesn't support system independent PBCs. So, cross your
+# fingers and try different filename for binary-dependent tests...
+.sub '_filename'
+ .local string filename
+ filename = 't/native_pbc/number_1.pbc'
+ .return (filename)
+.end
+
+# common pbc loading function
+.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"
+ $S0 = '_filename'()
+ pio = open $S0, 'r'
+ $S0 = pio.'readall'()
+ close pio
+ pf = $S0
+ .return(pf)
+.end
# Local Variables:
# mode: cperl
More information about the parrot-commits
mailing list