Merge pull request #34 from nomennescio/fix-issue-33

Fix issue 33

Author: nomennescio

test/test-error-handling.expected

@@ -3,26 +3,38 @@
 
 <IT::>Unexpected system error in user code
 
-<ERROR::>ERROR:{ division-by-zero { x 1 } }
+<ERROR::>Thrown: ERROR:{ division-by-zero { x 1 } }
 
-<COMPLETEDIN::>0.382253 ms
+<COMPLETEDIN::>0.274156 ms
 
 <IT::>Unexpected custom error in user code
 
-<ERROR::>ERROR:{ custom-error { error-message "thrown custom error" } {...
+<ERROR::>Thrown: ERROR:{ custom-error { error-message "thrown custom error" } {...
 
-<COMPLETEDIN::>0.110253 ms
+<COMPLETEDIN::>0.179815 ms
 
 <IT::>Expected custom error
 
 <PASSED::>Test Passed
 
-<COMPLETEDIN::>0.089989 ms
+<COMPLETEDIN::>0.059046 ms
 
 <IT::>Missing expected custom error
 
-<FAILED::>Test Failed : Expected :<:LF:>ERROR:{ custom-error<:LF:>    { error-message "thrown custom error" }<:LF:>    { integer-argument 1 }<:LF:>}<:LF:>but got :<:LF:>1
+<FAILED::>Test Failed : Expected :<:LF:>THROWN: ERROR:{ custom-error<:LF:>    { error-message "thrown custom error" }<:LF:>    { integer-argument 1 }<:LF:>}<:LF:>but got :<:LF:>1
 
-<COMPLETEDIN::>0.239820 ms
+<COMPLETEDIN::>0.166183 ms
 
-<COMPLETEDIN::>1.043601 ms
+<IT::>Missing expected thrown error
+
+<FAILED::>Test Failed : Expected :<:LF:>THROWN: "thrown error"<:LF:>but got :<:LF:>"thrown error"
+
+<COMPLETEDIN::>0.028068 ms
+
+<IT::>Missing expected thrown custom error
+
+<FAILED::>Test Failed : Expected :<:LF:>THROWN: ERROR:{ custom-error<:LF:>    { error-message "thrown custom error" }<:LF:>    { integer-argument 1 }<:LF:>}<:LF:>but got :<:LF:>ERROR:{ custom-error<:LF:>    { error-message "thrown custom error" }<:LF:>    { integer-argument 1 }<:LF:>}
+
+<COMPLETEDIN::>0.056286 ms
+
+<COMPLETEDIN::>0.952354 ms

test/test-error-handling.factor

@@ -1,9 +1,10 @@
 ! Copyright 2022 nomennescio
 
-USING: tools.testest math ;
+USING: tools.testest kernel math ;
 IN: tests
 
 ERROR: custom-error error-message integer-argument ;
+C: <custom-error> custom-error
 
 : run-tests ( -- )
 
@@ -20,6 +21,12 @@ ERROR: custom-error error-message integer-argument ;
   "Missing expected custom error" it#{
      <{ 1 -> "thrown custom error" 1 custom-error }>
   }#
+  "Missing expected thrown error" it#{
+     <{ "thrown error" -> "thrown error" throw }>
+  }#
+  "Missing expected thrown custom error" it#{
+     <{ "thrown custom error" 1 <custom-error> -> "thrown custom error" 1 custom-error }>
+  }#
 }#
 ;
 

test/test-stack-underflow.expected

@@ -3,39 +3,39 @@
 
 <IT::>single test
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<COMPLETEDIN::>0.052173 ms
+<COMPLETEDIN::>0.143086 ms
 
 <IT::>double test
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<COMPLETEDIN::>0.020681 ms
+<COMPLETEDIN::>0.019864 ms
 
 <IT::>double test
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<COMPLETEDIN::>0.013233 ms
+<COMPLETEDIN::>0.015669 ms
 
 <IT::>double test
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<ERROR::>Data stack underflow
+<ERROR::>Thrown: Data stack underflow
 
 
-<COMPLETEDIN::>0.012404 ms
+<COMPLETEDIN::>0.015315 ms
 
-<COMPLETEDIN::>0.314743 ms
+<COMPLETEDIN::>0.341698 ms

tools/testest/testest.factor

@@ -23,7 +23,7 @@ SYMBOL: test-failed.
 
 <PRIVATE
 
-: with-message ( quot -- message ) with-string-writer unclip-last [ "\n" "<:LF:>" replace ] dip suffix write ; inline
+: with-message ( quot -- ) with-string-writer unclip-last [ "\n" "<:LF:>" replace ] dip suffix write ; inline
 
 : passed. ( -- ) [ test-passed. get call( -- ) ] with-message ; inline
 : failed. ( error -- ) [ test-failed. get call( error -- ) ] with-message ; inline
@@ -32,10 +32,15 @@ SYMBOL: test-failed.
 : failed# ( -- ) nl "<FAILED::>" write ;
 : error# ( -- ) nl "<ERROR::>" write ;
 
-: catch-all ( stack quot -- stack' throwed? ) '[ _ _ with-datastack f ] [ 1array t ] recover ; inline
+ERROR: thrown error ;
+
+: catch-all ( stack quot -- stack' ) '[ _ _ with-datastack ] [ \ thrown boa 1array ] recover ; inline
+
+: unexpected-error? ( obj1 obj2 -- ? ) ?first thrown? not swap ?first thrown? and ;
 
 : (unit-test) ( test-quot expected-quot -- )
-  [ { } swap catch-all ] bi@ not rot and [ drop first error# [ print-error ] with-message nl ] 
+  [ { } swap catch-all ] bi@ 2dup unexpected-error?
+  [ drop first error# [ print-error ] with-message nl ]
   [ '[ _ _ assert-sequence= passed# passed. nl ] [ failed# failed. nl ] recover ] if
 ;
 
@@ -66,12 +71,17 @@ SYMBOL: ERROR:{
 : pprint-error ( error-tuple -- ) [ ERROR:{ ] dip [ class-of ] [ tuple>assoc ] bi \ } (pprint-tuple) ;
 
 ! print errors differently from tuples
+
 M: tuple pprint* dup class-of error-class? [ pprint-error ] [ pprint-tuple ] if ;
 M: tuple error. dup class-of error-class? [ pprint-short ] [ describe ] if ;
 
+SYMBOL: THROWN:
+M: thrown pprint* \ THROWN: pprint-word error>> pprint* ;
+M: thrown error. "Thrown: " write error>> error. ;
+
 M: assert-sequence error.
   [ "Expected :" write expected>> seq. ]
   [ nl "but got :" write got>> seq. ] bi
 ;
 
-PRIVATE>
+PRIVATE>