[svn:parrot] r41073 - in trunk: runtime/parrot/include runtime/parrot/library/Test t/library

[dukeleto at svn.parrot.org]

Author: dukeleto
Date: Sun Sep  6 17:42:06 2009
New Revision: 41073
URL: https://trac.parrot.org/parrot/changeset/41073

Log:
[t] Added pir_error_output_like to test_more.pir

Modified:
   trunk/runtime/parrot/include/test_more.pir
   trunk/runtime/parrot/library/Test/More.pir
   trunk/t/library/test_more.t

Modified: trunk/runtime/parrot/include/test_more.pir
==============================================================================
--- trunk/runtime/parrot/include/test_more.pir	Sun Sep  6 17:14:48 2009	(r41072)
+++ trunk/runtime/parrot/include/test_more.pir	Sun Sep  6 17:42:06 2009	(r41073)
@@ -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'
+    exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo pir_error_output_like'
 
     test_namespace.'export_to'(curr_namespace, exports)
 

Modified: trunk/runtime/parrot/library/Test/More.pir
==============================================================================
--- trunk/runtime/parrot/library/Test/More.pir	Sun Sep  6 17:14:48 2009	(r41072)
+++ trunk/runtime/parrot/library/Test/More.pir	Sun Sep  6 17:42:06 2009	(r41073)
@@ -13,7 +13,7 @@
     .local pmc exports, curr_namespace, test_namespace
     curr_namespace = get_namespace
     test_namespace = get_namespace [ 'Test'; 'More' ]
-    exports        = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo'
+    exports        = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo pir_error_output_like'
 
     test_namespace.'export_to'(curr_namespace, exports)
 
@@ -814,6 +814,54 @@
     .return( equal )
 .end
 
+=item C<pir_error_output_like( codestring, pattern, description )>
+
+Takes PIR code in C<codestring> and a PGE pattern to match in C<pattern>, 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 pir_error_output_like
+    .param string target
+    .param string pattern
+    .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
+    like(error_msg, pattern, description)
+
+  done:
+.end
+
 =item C<like( target, pattern, description )>
 
 Similar to is, but using the Parrot Grammar Engine to compare the string
@@ -995,7 +1043,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (C) 2005-2008, Parrot Foundation.
+Copyright (C) 2005-2009, Parrot Foundation.
 
 =cut
 

Modified: trunk/t/library/test_more.t
==============================================================================
--- trunk/t/library/test_more.t	Sun Sep  6 17:14:48 2009	(r41072)
+++ trunk/t/library/test_more.t	Sun Sep  6 17:42:06 2009	(r41073)
@@ -1,5 +1,5 @@
-#!./parrot
-# Copyright (C) 2005-2008, Parrot Foundation.
+#!parrot
+# Copyright (C) 2005-2009, Parrot Foundation.
 # $Id$
 
 .sub _main :main
@@ -15,14 +15,14 @@
     .local pmc exports, curr_namespace, test_namespace
     curr_namespace = get_namespace
     test_namespace = get_namespace [ 'Test'; 'More' ]
-    exports = split " ", "ok is diag like skip todo is_deeply isa_ok isnt"
+    exports = split " ", "ok is diag like skip todo is_deeply isa_ok isnt pir_error_output_like"
     test_namespace.'export_to'(curr_namespace, exports)
 
     test_namespace = get_namespace [ 'Test'; 'Builder'; 'Tester' ]
     exports = split " ", "plan test_out test_diag test_fail test_pass test_test"
     test_namespace.'export_to'(curr_namespace, exports)
 
-    plan( 75 )
+    plan( 78 )
 
     test_skip()
     test_todo()
@@ -32,11 +32,45 @@
     test_like()
     test_is_deeply()
     test_diagnostics()
+    test_pir_error_output_like()
     test_isa_ok()
 
     test.'finish'()
 .end
 
+.sub test_pir_error_output_like
+
+    test_fail('pir_error_output_like fails when there is no error')
+
+    pir_error_output_like( <<'CODE', 'somejunk', 'pir_error_output_like fails when there is no error')
+.sub main
+    $I0 = 42
+.end
+CODE
+
+    test_diag( 'no error thrown' )
+    test_test( 'pir_error_output_like fails when there is no error')
+    test_pass('pir_error_output_like passes when error matches pattern')
+
+    pir_error_output_like( <<'CODE', '<[for the lulz]>','pir_error_output_like passes when error matches pattern')
+.sub main
+    die 'I did it for the lulz'
+.end
+CODE
+
+    test_test( 'pir_error_output_like passes when error matches pattern' )
+
+    test_fail( 'pir_error_output_like fails when error does not match pattern' )
+
+    pir_error_output_like( <<'CODE', '<[for the lulz]>','pir_error_output_like fails when error does not match pattern')
+.sub main
+    die 'DO NOT WANT'
+.end
+CODE
+    test_diag( 'match failed' )
+    test_test('pir_error_output_like fails when error does not match pattern' )
+.end
+
 .sub test_ok
     test_pass()
     ok( 1 )