[svn:parrot] r41655 - in branches/pcc_reapply: runtime/parrot/include runtime/parrot/library/Test t/pmc
tene at svn.parrot.org
tene at svn.parrot.org
Sat Oct 3 23:34:50 UTC 2009
Author: tene
Date: Sat Oct 3 23:34:49 2009
New Revision: 41655
URL: https://trac.parrot.org/parrot/changeset/41655
Log:
Add 'substring' and 'throws_substring' functions to Test::More
Use substring functions instead of PGE in three tests.
Modified:
branches/pcc_reapply/runtime/parrot/include/test_more.pir
branches/pcc_reapply/runtime/parrot/library/Test/More.pir
branches/pcc_reapply/t/pmc/fixedpmcarray.t
branches/pcc_reapply/t/pmc/integer.t
branches/pcc_reapply/t/pmc/namespace.t
Modified: branches/pcc_reapply/runtime/parrot/include/test_more.pir
==============================================================================
--- branches/pcc_reapply/runtime/parrot/include/test_more.pir Sat Oct 3 23:30:30 2009 (r41654)
+++ branches/pcc_reapply/runtime/parrot/include/test_more.pir Sat Oct 3 23:34:49 2009 (r41655)
@@ -20,7 +20,7 @@
.local pmc exports, curr_namespace, test_namespace
curr_namespace = get_namespace
test_namespace = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
- exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo throws_like'
+ exports = split ' ', 'plan diag ok nok is is_deeply like substring isa_ok skip isnt todo throws_like throws_substring'
test_namespace.'export_to'(curr_namespace, exports)
Modified: branches/pcc_reapply/runtime/parrot/library/Test/More.pir
==============================================================================
--- branches/pcc_reapply/runtime/parrot/library/Test/More.pir Sat Oct 3 23:30:30 2009 (r41654)
+++ branches/pcc_reapply/runtime/parrot/library/Test/More.pir Sat Oct 3 23:34:49 2009 (r41655)
@@ -886,6 +886,85 @@
done:
.end
+=item C<throws_substring( codestring, text, description )>
+
+Takes PIR code in C<codestring> and a string to match in C<text>, as
+well as an optional message in C<description>. Passes a test if the PIR throws
+an exception that matches the pattern, fails the test otherwise.
+
+=cut
+
+.sub throws_substring
+ .param string target
+ .param string text
+ .param string description :optional
+
+ .local pmc test
+ get_hll_global test, [ 'Test'; 'More' ], '_test'
+
+ .local pmc comp
+ .local pmc compfun
+ .local pmc compiler
+ compiler = compreg 'PIR'
+
+ .local pmc eh
+ eh = new 'ExceptionHandler'
+ set_addr eh, handler # set handler label for exceptions
+ push_eh eh
+
+ compfun = compiler(target)
+ compfun() # eval the target code
+
+ pop_eh
+
+ # if it doesn't throw an exception, fail
+ test.'ok'( 0, description )
+ test.'diag'( 'no error thrown' )
+
+ goto done
+
+ handler:
+ .local pmc ex
+ .local string error_msg
+ .get_results (ex)
+ pop_eh
+ error_msg = ex
+ substring(error_msg, text, description)
+
+ done:
+.end
+
+=item C<substring( target, text, description )>
+
+Similar to is, but using the index opcode to compare the string passed as
+C<text> to the string passed as C<target>. It passes if C<text> is a substring
+of C<target> and fails otherwise. This will report the results with the
+optional test description in C<description>.
+
+=cut
+
+.sub substring
+ .param string target
+ .param string text
+ .param string description :optional
+
+ .local pmc test
+ .local string diagnostic
+ get_hll_global test, [ 'Test'; 'More' ], '_test'
+ $I0 = index target, text
+ $I0 = isne $I0, -1
+ test.'ok'( $I0, description )
+ if $I0 goto done
+ diagnostic = "substring failed: '"
+ diagnostic .= target
+ diagnostic .= "' does not contain '"
+ diagnostic .= text
+ diagnostic .= "'"
+ test.'diag'(diagnostic)
+ done:
+.end
+
+
=item C<like( target, pattern, description )>
Similar to is, but using the Parrot Grammar Engine to compare the string
Modified: branches/pcc_reapply/t/pmc/fixedpmcarray.t
==============================================================================
--- branches/pcc_reapply/t/pmc/fixedpmcarray.t Sat Oct 3 23:30:30 2009 (r41654)
+++ branches/pcc_reapply/t/pmc/fixedpmcarray.t Sat Oct 3 23:34:49 2009 (r41655)
@@ -310,7 +310,7 @@
concat s, aux
aux = get_repr_fpa_n(3)
concat s, aux
- like(s,'\(\)\(0\)\(0\,\s*1\)\(0\,\s*1\,\s*2\)','get_repr')
+ substring(s,'()(0)(0, 1)(0, 1, 2)','get_repr')
.end
.sub get_repr_fpa_n
@@ -333,7 +333,7 @@
.end
.sub test_splice_oob
- throws_like(<<'CODE',':s FixedPMCArray\: index out of bounds','splice oob, offset 0')
+ throws_substring(<<'CODE','FixedPMCArray: index out of bounds','splice oob, offset 0')
.sub main
.local pmc fpa
fpa = new ['FixedPMCArray']
@@ -345,7 +345,7 @@
splice fpa, nil, 0, 6
.end
CODE
- throws_like(<<'CODE',':s FixedPMCArray\: index out of bounds','splice oob, big offset')
+ throws_substring(<<'CODE','FixedPMCArray: index out of bounds','splice oob, big offset')
.sub main
.local pmc fpa
fpa = new ['FixedPMCArray']
@@ -390,7 +390,7 @@
.end
.sub test_get_uninitialized
- throws_like(<<'CODE',':s Null PMC access in name','get uninitialized')
+ throws_substring(<<'CODE','Null PMC access in name','get uninitialized')
.sub main
.local pmc arr1
arr1 = new ['FixedPMCArray']
@@ -469,14 +469,14 @@
.end
.sub test_oob_elem
- throws_like(<<'CODE',':s FixedPMCArray\: index out of bounds\!','set out-of-bounds index')
+ throws_substring(<<'CODE','FixedPMCArray: index out of bounds!','set out-of-bounds index')
.sub main
new $P0, ['FixedPMCArray']
set $P0, 1
set $P0[1], -7
.end
CODE
- throws_like(<<'CODE',':s FixedPMCArray\: index out of bounds\!','set out-of-bounds index')
+ throws_substring(<<'CODE','FixedPMCArray: index out of bounds!','set out-of-bounds index')
.sub main
new $P0, ['FixedPMCArray']
set $P0, 1
@@ -487,14 +487,14 @@
.end
.sub test_negative_index
- throws_like(<<'CODE',':s FixedPMCArray\: index out of bounds\!','set negative index')
+ throws_substring(<<'CODE','FixedPMCArray: index out of bounds!','set negative index')
.sub main
new $P0, ['FixedPMCArray']
set $P0, 1
set $P0[-1], -7
.end
CODE
- throws_like(<<'CODE',':s FixedPMCArray\: index out of bounds\!','get negative index')
+ throws_substring(<<'CODE','FixedPMCArray: index out of bounds!','get negative index')
.sub main
new $P0, ['FixedPMCArray']
set $P0, 1
@@ -547,7 +547,7 @@
.end
.sub test_tt991
- throws_like(<<'CODE',':s FixedPMCArray\: Cannot set array size to a negative number','cannot create a negative length array')
+ throws_substring(<<'CODE','FixedPMCArray: Cannot set array size to a negative number','cannot create a negative length array')
.sub main
new $P0, ['FixedPMCArray']
set $P0, -1
@@ -556,7 +556,7 @@
.end
.sub test_resize_exception
- throws_like(<<'CODE',':s FixedPMCArray\: Can.t resize','cannot resize FixedPMCArray')
+ throws_substring(<<'CODE',"FixedPMCArray: Can't resize",'cannot resize FixedPMCArray')
.sub main
new $P0, ['FixedPMCArray']
set $I0,$P0
@@ -565,14 +565,14 @@
.end
CODE
- throws_like(<<'CODE',":s set_number_native.* not implemented in class .*FixedPMCArray", 'cannot use float as length to FixedPMCArray')
+ throws_substring(<<'CODE',"set_number_native() not implemented in class 'FixedPMCArray'", 'cannot use float as length to FixedPMCArray')
.sub main
new $P0, ['FixedPMCArray']
set $P0, 42.0
.end
CODE
- throws_like(<<'CODE',":s set_string_native.* not implemented in class .*FixedPMCArray", 'cannot use string as length to FixedPMCArray')
+ throws_substring(<<'CODE',"set_string_native() not implemented in class 'FixedPMCArray'", 'cannot use string as length to FixedPMCArray')
.sub main
new $P0, ['FixedPMCArray']
set $P0,"GIGO"
@@ -581,7 +581,7 @@
.end
.sub test_assign_non_array
- throws_like(<<'CODE', ':s Can.t set self from this type','assign from non-array')
+ throws_substring(<<'CODE', "Can't set self from this type",'assign from non-array')
.sub main
.local pmc arr, other
.local int n
Modified: branches/pcc_reapply/t/pmc/integer.t
==============================================================================
--- branches/pcc_reapply/t/pmc/integer.t Sat Oct 3 23:30:30 2009 (r41654)
+++ branches/pcc_reapply/t/pmc/integer.t Sat Oct 3 23:34:49 2009 (r41655)
@@ -51,7 +51,7 @@
.end
.sub test_get_as_base_bounds_check
- throws_like(<<'CODE', ':s get_as_base\: base out of bounds', 'get_as_base lower bound check')
+ throws_substring(<<'CODE', 'get_as_base: base out of bounds', 'get_as_base lower bound check')
.sub main
$P0 = new ['Integer']
$P0 = 42
@@ -59,7 +59,7 @@
say $S0
.end
CODE
- throws_like(<<'CODE', ':s get_as_base\: base out of bounds', 'get_as_base upper bound check')
+ throws_substring(<<'CODE', 'get_as_base: base out of bounds', 'get_as_base upper bound check')
.sub main
$P0 = new ['Integer']
$P0 = 42
Modified: branches/pcc_reapply/t/pmc/namespace.t
==============================================================================
--- branches/pcc_reapply/t/pmc/namespace.t Sat Oct 3 23:30:30 2009 (r41654)
+++ branches/pcc_reapply/t/pmc/namespace.t Sat Oct 3 23:34:49 2009 (r41655)
@@ -203,7 +203,7 @@
pop_eh
test4:
- throws_like( <<'CODE', 'Null\ PMC\ access\ in\ invoke', 'Invoking a non-existent sub')
+ throws_substring( <<'CODE', 'Null PMC access in invoke', 'Invoking a non-existent sub')
.sub main
$P0 = get_global ["Foo"], "SUB_THAT_DOES_NOT_EXIST"
$P0()
@@ -212,7 +212,7 @@
test5:
# this used to behave differently from the previous case.
- throws_like( <<'CODE', 'Null\ PMC\ access\ in\ invoke', 'Invoking a non-existent sub')
+ throws_substring( <<'CODE', 'Null PMC access in invoke', 'Invoking a non-existent sub')
.sub main
$P0 = get_global ["Foo";"Bar"], "SUB_THAT_DOES_NOT_EXIST"
$P0()
@@ -552,9 +552,9 @@
.sub 'export_to_method'
.local string errormsg, description
- errormsg = ":s destination namespace not specified"
+ errormsg = "destination namespace not specified"
description = "export_to() Null NameSpace"
- throws_like(<<"CODE", errormsg, description)
+ throws_substring(<<"CODE", errormsg, description)
.sub 'test' :main
.local pmc nsa, nsb, ar
@@ -566,9 +566,9 @@
.end
CODE
- errormsg = ":s exporting default object set not yet implemented"
+ errormsg = "exporting default object set not yet implemented"
description = 'export_to() with null exports default object set !!!UNSPECIFIED!!!'
- throws_like(<<'CODE', errormsg, description)
+ throws_substring(<<'CODE', errormsg, description)
.sub 'test' :main
.local pmc nsa, nsb, ar
@@ -580,9 +580,9 @@
CODE
- errormsg = ":s exporting default object set not yet implemented"
+ errormsg = "exporting default object set not yet implemented"
description = 'export_to() with empty array exports default object set !!!UNSPECIFIED!!!'
- throws_like(<<'CODE', errormsg, description)
+ throws_substring(<<'CODE', errormsg, description)
.sub 'test' :main
.local pmc nsa, nsb, ar
@@ -593,9 +593,9 @@
.end
CODE
- errormsg = ":s exporting default object set not yet implemented"
+ errormsg = "exporting default object set not yet implemented"
description = 'export_to() with empty hash exports default object set !!!UNSPECIFIED!!!'
- throws_like(<<'CODE', errormsg, description)
+ throws_substring(<<'CODE', errormsg, description)
.sub 'test' :main
.local pmc nsa, nsb, ar
More information about the parrot-commits
mailing list