t/pmc/exceptionhandler.t

   1 #! parrot
   2 # Copyright (C) 2006-2008, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/exception_handler.t - test ExceptionHandler PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/exceptionhandler.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the ExceptionHandler PMC.
  16
  17 =cut
  18
  19 .include 'except_severity.pasm'
  20 .include 'except_types.pasm'
  21
  22 .sub main :main
  23     .include 'test_more.pir'
  24
  25     # If test exited with "bad plan" MyHandlerCan.can_handle wasn't invoked.
  26     plan(9)
  27
  28     .local pmc eh
  29     eh = new ['ExceptionHandler']
  30     ok(1, 'Instantiated ExceptionHandler')
  31
  32     set_addr eh, nonfatal_handler_one
  33     eh.'min_severity'(.EXCEPT_NORMAL)
  34     eh.'max_severity'(.EXCEPT_WARNING)
  35     push_eh eh
  36
  37     eh = new ['ExceptionHandler']
  38     set_addr eh, error_handler_one
  39     eh.'min_severity'(.EXCEPT_ERROR)
  40     eh.'max_severity'(.EXCEPT_FATAL)
  41     push_eh eh
  42
  43     $P0 = new ['Exception']
  44     $P0['severity'] = .EXCEPT_NORMAL
  45     throw $P0
  46
  47     $P0 = new ['Exception']
  48     $P0['severity'] = .EXCEPT_SEVERE
  49     throw $P0
  50
  51     pop_eh
  52     pop_eh
  53
  54     goto more_tests
  55
  56   nonfatal_handler_one:
  57     .local pmc e, c
  58     .get_results (e)
  59     ok(1, 'Min and Max severity for exception handlers')
  60     c = e['resume']
  61     eh = 0
  62     c()
  63   error_handler_one:
  64     .get_results (e)
  65     ok(1, 'Min and Max severity for exception handlers')
  66     c = e['resume']
  67     eh = 0
  68     c()
  69
  70   more_tests:
  71
  72     eh = new ['ExceptionHandler']
  73     set_addr eh, typed_handler_one
  74     eh.'handle_types'(.CONTROL_OK, .CONTROL_BREAK)
  75     push_eh eh
  76
  77     eh = new ['ExceptionHandler']
  78     set_addr eh, typed_handler_two
  79     eh.'handle_types'(.EXCEPTION_SYNTAX_ERROR, .EXCEPTION_UNEXPECTED_NULL)
  80     push_eh eh
  81
  82     $P0 = new ['Exception']
  83     $P0['type'] = .CONTROL_OK
  84     throw $P0
  85
  86     $P0 = new ['Exception']
  87     $P0['type'] = .CONTROL_BREAK
  88     throw $P0
  89
  90     pop_eh
  91     pop_eh
  92
  93     goto subclass_handler
  94
  95   typed_handler_one:
  96     .get_results (e)
  97     ok(1, 'Exception Handler type checks work')
  98     c = e['resume']
  99     eh = 0
 100     c()
 101   typed_handler_two:
 102     .get_results (e)
 103     ok(0, 'Exception Handler type checks work')
 104     c = e['resume']
 105     eh = 0
 106     c()
 107
 108   subclass_handler:
 109     .local pmc myhandler, myhandlercan
 110     myhandler = subclass_exception_handler()
 111     myhandlercan = subclass_exception_handler_can()
 112     $I0 = subclass_handler_pop(myhandler)
 113     ok($I0, 'Exception Handler subclass popped')
 114     $I0 = subclass_handler_catches_can(myhandlercan)
 115     ok($I0, 'Exception Handler subclass with can_handle method catch exception')
 116
 117     # This test is not expected to die now.
 118     # Please report to TT #154 if it must be skipped again.
 119     #skip(1,'Exception Handler subclass causes segfault: TT #154')
 120     $I0 = 0
 121     push_eh outcatch
 122     $I0 = subclass_handler_catches(myhandler)
 123   outcatch:
 124     ok($I0, 'Exception Handler subclass catch exception')
 125 .end
 126
 127 .sub subclass_exception_handler
 128     .local pmc myhandler
 129     myhandler = subclass 'ExceptionHandler', [ 'MyHandler' ]
 130     .return(myhandler)
 131 .end
 132
 133 .sub subclass_exception_handler_can
 134     .local pmc myhandler
 135     myhandler = subclass 'ExceptionHandler', [ 'MyHandlerCan' ]
 136     .return(myhandler)
 137 .end
 138
 139 .sub subclass_handler_pop
 140     .param pmc myhandler
 141     .local pmc eh
 142     eh = new ['ExceptionHandler']
 143     set_addr eh, subclassed_popped
 144     push_eh eh
 145
 146     .local pmc myeh
 147     new myeh, myhandler
 148     set_addr myeh, subclassed_handler
 149     push_eh myeh
 150
 151     pop_eh
 152
 153     $P0 = new ['Exception']
 154     throw $P0
 155
 156   subclassed_popped:
 157     .return(1)
 158
 159   subclassed_handler:
 160     .return(0)
 161 .end
 162
 163 .sub subclass_handler_catches_can
 164     .param pmc myhandler
 165     .local pmc eh
 166     eh = new ['ExceptionHandler']
 167     set_addr eh, subclassed_failed
 168     push_eh eh
 169
 170     .local pmc myeh
 171     new myeh, myhandler
 172     set_addr myeh, subclassed_handler
 173     push_eh myeh
 174
 175     $P0 = new ['Exception']
 176     throw $P0
 177
 178   subclassed_failed:
 179     .get_results($P0)
 180     .return(0)
 181
 182   subclassed_handler:
 183     .get_results($P0)
 184     .return(1)
 185 .end
 186
 187 .sub subclass_handler_catches
 188     .param pmc myhandler
 189     .local pmc eh
 190     eh = new ['ExceptionHandler']
 191     set_addr eh, subclassed_failed
 192     push_eh eh
 193
 194     .local pmc myeh
 195     new myeh, myhandler
 196     set_addr myeh, subclassed_handler
 197     push_eh myeh
 198
 199     $P0 = new ['Exception']
 200     throw $P0
 201
 202   subclassed_failed:
 203     .get_results($P0)
 204     .return(0)
 205
 206   subclassed_handler:
 207     .get_results($P0)
 208     .return(1)
 209 .end
 210
 211 .namespace [ 'MyHandler' ]
 212
 213 .namespace [ 'MyHandlerCan' ]
 214
 215 .sub can_handle :method
 216     .param pmc ex
 217     ok(1, 'MyHandlerCan.can_handle invoked')
 218     .return(1)
 219 .end
 220
 221 # Local Variables:
 222 #   mode: pir
 223 #   fill-column: 100
 224 # End:
 225 # vim: expandtab shiftwidth=4 ft=pir: