Ticket #722: capture.t.patch
File capture.t.patch, 12.5 KB (added by bobw, 13 years ago) 


t/pmc/capture.t
1 #!p erl1 #!parrot 2 2 # Copyright (C) 20012008, Parrot Foundation. 3 3 # $Id$ 4 4 5 use strict;6 use warnings;7 use lib qw( . lib ../lib ../../lib );8 9 use Test::More;10 use Parrot::Test tests => 8;11 12 5 =head1 NAME 13 6 14 7 t/pmc/capture.t  Test the Capture PMC … … 24 17 25 18 =cut 26 19 27 my $PRE = <<PRE; 28 .sub 'test' :main 29 .local pmc capt 30 capt = new ['Capture'] 31 PRE 20 .namespace [] 32 21 33 my $POST = <<POST; 22 .include "except_types.pasm" 23 24 .sub main :main 25 .include 'test_more.pir' 26 27 plan(47) 28 29 new_test() # 1 test 30 basic_capture_tests() # 23 tests 31 defined_delete_exists() # 16 tests 32 hash_list() # 2 tests 33 get_integer_not_implemented() # 1 test 34 get_number_not_implemented() # 1 test 35 keyed_int_delegation() # 2 tests 36 list_method_delegation() # 1 test 37 .end 38 39 .sub new_test 40 .local pmc capt, eh 41 42 eh = new ['ExceptionHandler'] 43 # eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED) 44 set_addr eh, eh_label 45 46 push_eh eh 47 capt = new ['Capture'] 48 pop_eh 49 50 ok(1, 'new works correctly') 34 51 goto end 35 nok: 36 print 'not ' 37 ok:38 say 'ok' 39 52 53 eh_label: 54 ok(0, 'new does not work correctly') 55 56 end: 40 57 .end 41 POST42 58 43 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', 'new' ); 44 CODE 45 OUT 59 .sub basic_capture_tests 60 .local pmc capt, intpmc, pval 61 .local int ival 62 .local num nval 63 .local string sval 46 64 47 pir_output_is( <<'CODE', <<'OUTPUT', "Basic capture tests" );48 .sub main :main49 .local pmc capt50 65 capt = new ['Capture'] 51 66 52 67 capt[0] = 0 53 68 capt[1] = 1.5 54 69 capt[2] = 'two' 55 $P0= new ['Integer']56 $P0= 357 capt[3] = $P070 intpmc = new ['Integer'] 71 intpmc = 3 72 capt[3] = intpmc 58 73 59 74 push capt, 4 60 75 push capt, 5.5 61 76 push capt, 'six' 62 $P0= new ['Integer']63 $P0= 764 push capt, $P077 intpmc = new ['Integer'] 78 intpmc = 7 79 push capt, intpmc 65 80 66 81 unshift capt, 8 67 82 unshift capt, 9.5 68 83 unshift capt, 'ten' 69 $P0= new ['Integer']70 $P0= 1171 unshift capt, $P084 intpmc = new ['Integer'] 85 intpmc = 11 86 unshift capt, intpmc 72 87 73 88 capt['alpha'] = 12 74 89 capt['beta'] = 13.5 75 90 capt['gamma'] = 'fourteen' 76 $P0= new ['Integer']77 $P0= 1578 capt['delta'] = $P091 intpmc = new ['Integer'] 92 intpmc = 15 93 capt['delta'] = intpmc 79 94 80 $I0 = elements capt 81 print $I0 82 print "\n" 95 ival = elements capt 96 is(ival, 12, '12 elements count of capture correctly') 83 97 84 $I0 = capt[11] 85 print $I0 86 print " " 87 $P0 = capt[10] 88 print $P0 89 print " " 90 $N0 = capt[9] 91 print $N0 92 print " " 93 $S0 = capt[8] 94 say $S0 98 ival = capt[11] 99 is(ival, 7, 'element 11 of capture is correct') 95 100 96 $I0 = pop capt 97 print $I0 98 print " " 99 $P0 = pop capt 100 print $P0 101 print " " 102 $N0 = pop capt 103 print $N0 104 print " " 105 $S0 = pop capt 106 say $S0 101 pval = capt[10] 102 is(pval, 'six', 'element 10 of capture is correct') 107 103 108 $I0 = elements capt 109 print $I0 110 print "\n" 104 nval = capt[9] 105 is(nval, '5.5', 'element 9 of capture is correct') 111 106 112 $I0 = shift capt 113 print $I0 114 print " " 115 $P0 = shift capt 116 print $P0 117 print " " 118 $N0 = shift capt 119 print $N0 120 print " " 121 $S0 = shift capt 122 say $S0 107 sval = capt[8] 108 is(sval, '4', 'element 8 of capture is correct') 123 109 124 $I0 = elements capt 125 print $I0 126 print "\n" 110 ival = pop capt 111 is(ival, 7, 'first popped element of capture is correct') 127 112 128 loop: 129 $I0 = elements capt 130 if $I0 < 1 goto end 131 $P0 = pop capt 132 say $P0 133 goto loop 134 end: 113 pval = pop capt 114 is(pval, 'six', 'second popped element of capture is correct') 135 115 136 $I0 = capt['delta'] 137 print $I0 138 print " " 139 $P0 = capt['gamma'] 140 print $P0 141 print " " 142 $N0 = capt['beta'] 143 print $N0 144 print " " 145 $S0 = capt['alpha'] 146 say $S0 116 nval = pop capt 117 is(nval, '5.5', 'third popped element of capture is correct') 147 118 119 sval = pop capt 120 is(sval, '4', 'fourth popped element of capture is correct') 121 122 ival = elements capt 123 is(ival, 8, 'number of element after 4 pops is correct') 124 125 ival = shift capt 126 is(ival, 11, 'first shifted element of is correct') 127 128 pval = shift capt 129 is(pval, 'ten', 'second shifted element of capture is correct') 130 131 nval = shift capt 132 is(nval, '9.5', 'third shifted element of capture is correct') 133 134 sval = shift capt 135 is(sval, '8', 'fourth shifted element of capture is correct') 136 137 ival = elements capt 138 is(ival, 4, 'number of element after 4 shifts is correct') 139 140 pval = pop capt 141 is(pval, 3, 'first popped element of capture is correct') 142 143 pval = pop capt 144 is(pval, 'two', 'second popped element of capture is correct') 145 146 pval = pop capt 147 is(pval, '1.5', 'third popped element of capture is correct') 148 149 pval = pop capt 150 is(pval, '0', 'fourth popped element of capture is correct') 151 152 ival = capt['delta'] 153 is(ival, 15, 'integer keyed element of capture is correct') 154 155 pval = capt['gamma'] 156 is(pval, 'fourteen', 'pmc keyed element of capture is correct') 157 158 nval = capt['beta'] 159 is(nval, 13.5, 'number keyed element of capture is correct') 160 161 sval = capt['alpha'] 162 is(sval, '12', 'string keyed element of capture is correct') 148 163 .end 149 164 150 CODE 151 12 152 7 six 5.5 4 153 7 six 5.5 4 154 8 155 11 ten 9.5 8 156 4 157 3 158 two 159 1.5 160 0 161 15 fourteen 13.5 12 162 OUTPUT 165 .sub defined_delete_exists 166 .local pmc capt,pval 167 .local int defined_bool, exists_bool 163 168 164 pir_output_is( <<'CODE', <<'OUTPUT', "defined, delete, exists" );165 .sub main :main166 .local pmc capt167 169 capt = new ['Capture'] 168 170 169 $I0 = defined capt[2] 170 $I1 = exists capt[2] 171 print $I0 172 print " " 173 print $I1 174 print "\n" 171 defined_bool = defined capt[2] 172 is(defined_bool, 0, 'uninitialised indexed element is undefined correctly') 175 173 176 $I0 = defined capt['alpha'] 177 $I1 = exists capt['alpha'] 178 print $I0 179 print " " 180 print $I1 181 print "\n" 174 exists_bool = exists capt[2] 175 is(exists_bool, 0, 'uninitialised indexed element does not exist correctly') 182 176 177 defined_bool = defined capt['alpha'] 178 is(defined_bool, 0, 'uninitialised keyed element is undefined correctly') 179 180 exists_bool = exists capt['alpha'] 181 is(exists_bool, 0, 'uninitialised keyed element does not exist correctly') 182 183 183 capt[2] = 1 184 184 capt['alpha'] = 1 185 $P0= new ['Undef']186 capt['beta'] = $P0185 pval = new ['Undef'] 186 capt['beta'] = pval 187 187 188 $I0 = defined capt[2] 189 $I1 = exists capt[2] 190 print $I0 191 print " " 192 print $I1 193 print "\n" 188 defined_bool = defined capt[2] 189 is(defined_bool, 1, 'initialised indexed element is defined correctly') 194 190 195 $I0 = defined capt['alpha'] 196 $I1 = exists capt['alpha'] 197 print $I0 198 print " " 199 print $I1 200 print "\n" 191 exists_bool = exists capt[2] 192 is(exists_bool, 1, 'initialised indexed element exists correctly') 201 193 202 $I0 = defined capt[1] 203 $I1 = exists capt[1] 204 print $I0 205 print " " 206 print $I1 207 print "\n" 194 defined_bool = defined capt['alpha'] 195 is(defined_bool, 1, 'initialised keyed element is defined correctly') 208 196 209 $I0 = defined capt['beta'] 210 $I1 = exists capt['beta'] 211 print $I0 212 print " " 213 print $I1 214 print "\n" 197 exists_bool = exists capt['alpha'] 198 is(exists_bool, 1, 'initialised keyed element exists correctly') 215 199 200 defined_bool = defined capt[1] 201 is(defined_bool, 0, 'uninitialised indexed element is undefined correctly') 202 203 exists_bool = exists capt[1] 204 is(exists_bool, 0, 'uninitialised indexed element does not exist correctly') 205 206 defined_bool = defined capt['beta'] 207 is(defined_bool, 0, 'null initialised keyed element is undefined correctly') 208 209 exists_bool = exists capt['beta'] 210 is(exists_bool, 1, 'null initialised keyed element exists correctly') 211 216 212 delete capt[2] 217 213 delete capt['alpha'] 218 214 219 $I0 = defined capt[2] 220 $I1 = exists capt[2] 221 print $I0 222 print " " 223 print $I1 224 print "\n" 215 defined_bool = defined capt[2] 216 is(defined_bool, 0, 'deleted indexed element is undefined correctly') 225 217 226 $I0 = defined capt['alpha'] 227 $I1 = exists capt['alpha'] 228 print $I0 229 print " " 230 print $I1 231 print "\n" 218 exists_bool = exists capt[2] 219 is(exists_bool, 0, 'deleted indexed element does not exist correctly') 232 220 221 defined_bool = defined capt['alpha'] 222 is(defined_bool, 0, 'deleted keyed element is undefined correctly') 233 223 224 exists_bool = exists capt['alpha'] 225 is(exists_bool, 0, 'deleted keyed element does not exist correctly') 234 226 .end 235 CODE236 0 0237 0 0238 1 1239 1 1240 0 0241 0 1242 0 0243 0 0244 OUTPUT245 227 246 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUTPUT', "hash, list" ); 247 $P0 = capt.'list'()248 $P1 = capt.'hash'()228 .sub hash_list 229 .local pmc capt, list_pmc, hash_pmc 230 .local string list_type, hash_type 249 231 250 $S0 = typeof $P0 251 $S1 = typeof $P1 232 capt = new ['Capture'] 252 233 253 say $S0 254 say $S1 255 CODE 256 ResizablePMCArray 257 Hash 258 OUTPUT 234 list_pmc = capt.'list'() 235 hash_pmc = capt.'hash'() 259 236 260 pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_integer not implemented' ); 261 $I0 = capt 262 CODE 263 /get_integer\(\) not implemented in class 'Capture'/ 264 OUT 237 list_type = typeof list_pmc 238 is(list_type, 'ResizablePMCArray', 'list is correct type') 265 239 266 pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_number not implemented' ); 267 $N0 = capt 268 CODE 269 /get_number\(\) not implemented in class 'Capture'/ 270 OUT 240 hash_type = typeof hash_pmc 241 is(hash_type, 'Hash', 'hash is correct type') 242 .end 271 243 272 pir_output_is( <<'CODE', <<'OUTPUT', '*_keyed_int delegation' ); 273 .sub main :main 274 $P99 = subclass 'Capture', 'Match' 275 $P1 = new ['Match'] 276 $P1[1] = 1 277 $I1 = elements $P1 278 print $I1 279 print "\n" 244 .sub get_integer_not_implemented 245 .local pmc capt, eh 246 .local int ival 280 247 281 $P99 = subclass 'Match', 'Exp' 282 $P2 = new ['Exp'] 283 $P2[1] = 1 284 $I2 = elements $P2 285 print $I2 286 print "\n" 248 eh = new ['ExceptionHandler'] 249 # eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED) 250 set_addr eh, eh_label 287 251 252 capt = new ['Capture'] 253 254 push_eh eh 255 ival = capt 256 pop_eh 257 258 ok(0, 'get_integer_not_implemented') 259 goto end 260 261 eh_label: 262 .local string message 263 .get_results($P0) 264 message = $P0['message'] 265 is(message, "get_integer() not implemented in class 'Capture'", 'get_integer_not_implemented') 266 267 end: 288 268 .end 289 CODE290 2291 2292 OUTPUT293 269 294 pir_output_is( <<'CODE', <<'OUTPUT', 'list method delegation' ); 295 .sub main :main 296 $P0 = subclass 'Capture', 'Match' 297 addattribute $P0, '$.abc' 298 addattribute $P0, '$.xyz' 299 $P1 = new ['Match'] 300 $P1[1] = 1 270 .sub get_number_not_implemented 271 .local pmc capt, eh 272 .local num nval 301 273 302 $P2 = new ['String'] 303 setattribute $P1, '$.abc', $P2 304 $P2 = new ['String'] 305 setattribute $P1, '$.xyz', $P2 274 eh = new ['ExceptionHandler'] 275 # eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED) 276 set_addr eh, eh_label 306 277 307 $P2 = $P1.'list'() 308 $P2 = 0 309 $I0 = elements $P2 310 print $I0 311 print "\n" 278 capt = new ['Capture'] 279 280 push_eh eh 281 nval = capt 282 pop_eh 283 284 ok(0, 'get_number_not_implemented') 285 goto end 286 287 eh_label: 288 .local string message 289 .get_results($P0) 290 message = $P0['message'] 291 is(message, "get_number() not implemented in class 'Capture'", 'get_number_not_implemented') 292 293 end: 312 294 .end 313 CODE314 0315 OUTPUT316 295 296 .sub keyed_int_delegation 297 .local pmc capt, foo, bar, baz 298 .local int ival 299 300 foo = subclass 'Capture', 'Match' 301 bar = new ['Match'] 302 bar[1] = 1 303 ival = elements bar 304 is(ival, 2, 'first keyed_int_delegation test correct') 305 306 foo = subclass 'Match', 'Exp' 307 baz = new ['Exp'] 308 baz[1] = 1 309 ival = elements baz 310 is(ival, 2, 'second keyed_int_delegation test correct') 311 .end 312 313 .sub list_method_delegation 314 .local pmc capt, foo, bar, baz 315 .local int ival 316 317 foo = subclass 'Capture', 'Match2' 318 addattribute foo, '$.abc' 319 addattribute foo, '$.xyz' 320 bar = new ['Match2'] 321 bar[1] = 1 322 323 baz = new ['String'] 324 setattribute bar, '$.abc', baz 325 baz = new ['String'] 326 setattribute bar, '$.xyz', baz 327 328 baz = bar.'list'() 329 baz = 0 330 ival = elements baz 331 is(ival, 0, 'list_method_delegation test correct') 332 .end 333 317 334 # Local Variables: 318 335 # mode: cperl 319 336 # cperlindentlevel: 4