[svn:parrot] r46138 - trunk/t/pmc
NotFound at svn.parrot.org
NotFound at svn.parrot.org
Thu Apr 29 13:47:32 UTC 2010
Author: NotFound
Date: Thu Apr 29 13:47:31 2010
New Revision: 46138
URL: https://trac.parrot.org/parrot/changeset/46138
Log:
improve packfile PMCs tests
Modified:
trunk/t/pmc/packfile.t
trunk/t/pmc/packfileannotations.t
Modified: trunk/t/pmc/packfile.t
==============================================================================
--- trunk/t/pmc/packfile.t Thu Apr 29 13:10:59 2010 (r46137)
+++ trunk/t/pmc/packfile.t Thu Apr 29 13:47:31 2010 (r46138)
@@ -22,7 +22,7 @@
.sub main :main
.include 'test_more.pir'
- plan(34)
+ plan(36)
'test_new'()
'test_get_string'()
'test_set_string'()
@@ -32,8 +32,22 @@
'test_load'()
'test_pack_fresh_packfile'()
'test_pack'()
- # This test will crash on many platforms. See TT #545.
- #'test_synonyms'()
+
+ skip(2, "test_synonyms crash on many platforms. See TT #545")
+ # 'test_synonyms'()
+
+.end
+
+
+# Report no ok for loading packfile failures
+.sub report_load_error
+ .param pmc except
+ .param string desc
+ .local string msg, aux
+ msg = concat desc, ' - error loading packfile: '
+ aux = except['message']
+ msg = concat msg, aux
+ ok(0, msg)
.end
@@ -43,11 +57,10 @@
pf = new ['Packfile']
$I0 = defined pf
ok($I0, 'new')
- _check_header(pf)
+ .tailcall _check_header(pf)
.end
-# Packfile.get_integer_keyed_str
.sub 'test_get_string'
.local pmc pf
pf = new ['Packfile']
@@ -66,7 +79,6 @@
.return ()
.end
-# Packfile.get_integer_keyed_str
.sub 'test_set_string'
.local pmc pf
pf = new ['Packfile']
@@ -95,12 +107,11 @@
.end
-
-
-# Packfile.set_string_native, Packfile.get_integer_keyed_str
.sub 'test_get_integer'
.local pmc pf
+ push_eh load_error
pf = _pbc()
+ pop_eh
$I0 = pf["version_major"]
ok(1, "get_integer_keyed_str(version_major)")
@@ -120,14 +131,23 @@
pop_eh
ok(1, "get_integer_keyed_str handle unknown key properly")
.return ()
-
+load_error:
+ .get_results($P0)
+ pop_eh
+ report_load_error($P0, "get_integer_keyed_str(version_major)")
+ report_load_error($P0, "get_integer_keyed_str(version_minor)")
+ report_load_error($P0, "get_integer_keyed_str(version_patch)")
+ report_load_error($P0, "get_integer_keyed_str unknown key")
+ .return()
.end
# Packfile.set_integer_keyed_str
.sub 'test_set_integer'
.local pmc pf
+ push_eh load_error
pf = _pbc()
+ pop_eh
$S1 = 'version_major'
$I0 = pf[$S1]
$I1 = $I0
@@ -137,6 +157,12 @@
$I3 = cmp $I0, $I2
$I3 = cmp $I3, 0
ok($I3, 'set_integer_keyed_str version bumped')
+ .return()
+load_error:
+ .get_results($P0)
+ pop_eh
+ report_load_error($P0, 'set_integer_keyed_str version bumped')
+ .return()
.end
# Packfile.get_directory
@@ -151,12 +177,19 @@
# PackfileSegment.pack (via subclass PackfileDirectory)
.sub 'test_get_directory'
.local pmc pf, pfdir
+ push_eh load_error
pf = _pbc()
+ pop_eh
pfdir = pf.'get_directory'()
$S0 = pfdir.'pack'()
$I0 = length $S0
$I1 = cmp $I0, 0
ok($I1, 'get_directory')
+ .return()
+load_error:
+ .get_results($P0)
+ report_load_error($P0, 'get_directory')
+ .return()
.end
@@ -164,9 +197,17 @@
# Check that packfile was loaded properly and set various attributes
.sub 'test_load'
.local pmc pf
+ push_eh load_error
pf = _pbc()
+ pop_eh
- _check_header(pf)
+ .tailcall _check_header(pf)
+load_error:
+ .get_results($P0)
+ report_load_error($P0, "Wordsize set")
+ report_load_error($P0, "version_major set")
+ report_load_error($P0, "bytecode_major set")
+ .return()
.end
# Helper sub to check fields in Packfile header
@@ -265,6 +306,7 @@
# Check that unpack-pack produce correct result.
.sub 'test_pack'
.local string filename, first
+ push_eh load_error
$S0 = '_filename'()
$P0 = open $S0, 'r'
@@ -273,6 +315,7 @@
.local pmc packfile
packfile = new 'Packfile'
packfile = first
+ pop_eh
# Packed file should be exactly the same as loaded
.local string second
@@ -282,12 +325,19 @@
$I0 = cmp first, second
$I0 = not $I0
todo($I0, 'pack produced same result twice')
+ .return()
+load_error:
+ .get_results($P0)
+ report_load_error($P0, 'pack produced same result twice')
+ .return()
.end
# Test pack/set_string unpack/get_string equivalency
.sub 'test_synonyms'
.local pmc pf
+ push_eh load_error
pf = '_pbc'()
+ pop_eh
$S0 = pf
$S1 = pf.'pack'()
@@ -304,6 +354,12 @@
$S1 = $P1
$I0 = cmp $S0, $S1
is($I0, 0, "unpack and set_string are synonyms")
+ .return()
+load_error:
+ .get_results($P0)
+ report_load_error($P0, "pack and get_string are synonyms")
+ report_load_error($P0, "unpack and set_string are synonyms")
+ .return()
.end
Modified: trunk/t/pmc/packfileannotations.t
==============================================================================
--- trunk/t/pmc/packfileannotations.t Thu Apr 29 13:10:59 2010 (r46137)
+++ trunk/t/pmc/packfileannotations.t Thu Apr 29 13:47:31 2010 (r46138)
@@ -40,11 +40,19 @@
.sub 'test_unpack'
.local pmc pf
+ push_eh load_error
$P0 = open 't/native_pbc/annotations.pbc'
$S0 = $P0.'readall'()
pf = new 'Packfile'
pf = $S0
+ pop_eh
.tailcall '!test_unpack'(pf)
+load_error:
+ .get_results($P0)
+ pop_eh
+ nok(1, "PackfileAnnotations unpack failed to load test file")
+ skip(7, "PackfileAnnotations unpack tests failed")
+ .return()
.end
# Programatically create PBC same as t/native_pbc/annotations.pbc and check unpack of it.
@@ -146,7 +154,7 @@
fail:
nok(1, "PackfileAnnotations wasn't found in Directory")
# BAIL_OUT
- skip(9, "PackfileAnnotations tests failed")
+ skip(7, "PackfileAnnotations tests failed")
.end
# Local Variables:
More information about the parrot-commits
mailing list