t/pmc/class.t

   1 #! parrot
   2 # Copyright (C) 2007-2008, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/class.t - test the Class PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/class.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the Class PMC.
  16
  17 =cut
  18
  19
  20 .const int TESTS = 63
  21
  22
  23 .sub 'main' :main
  24      load_bytecode 'Test/More.pbc'
  25      .local pmc exporter, test_ns
  26      test_ns = get_namespace [ 'Test'; 'More' ]
  27      exporter = new ['Exporter']
  28      exporter.'import'( test_ns :named('source'), 'plan ok is isa_ok todo' :named('globals') )
  29
  30      plan(TESTS)
  31      'new op'()
  32      'class flag'()
  33      'name'()
  34      'new method'()
  35      'attributes'()
  36      'add_attribute'()
  37      'set_attr/get_attr'()
  38      'add_method'()
  39      'parents'()
  40      'roles'()
  41      'inspect'()
  42      'clone'()
  43      'clone_pmc'()
  44      'new with init hash'()
  45      'isa'()
  46      'does'()
  47      'more does'()
  48      'anon_inherit'()
  49 .end
  50
  51
  52 # L<PDD15/Class PMC API/=item new>
  53 .sub 'new op'
  54     .local pmc class
  55     .local int isa_class
  56     class = new ['Class']
  57
  58     ok(1, "$P0 = new ['Class']")
  59     isa_ok(class, 'Class')
  60 .end
  61
  62
  63 # L<PDD15/Class PMC API/'Class PMCs also have the "I am a class" flag set on them.'>
  64 .sub 'class flag'
  65     .local pmc class, class_flags_pmc
  66     .local int class_flags, class_flag_set
  67     .const int POBJ_IS_CLASS_FLAG = 536870912  # 1 << 29
  68
  69     class = new ['Class']
  70     class_flags_pmc = inspect class, 'flags'
  71     class_flags = class_flags_pmc
  72     class_flag_set = class_flags & POBJ_IS_CLASS_FLAG
  73     ok(class_flag_set, 'Class PMC has "I am a class" flag set')
  74 .end
  75
  76
  77
  78 # L<PDD15/Class PMC API/=item name>
  79 .sub 'name'
  80     .local pmc class, result
  81     class = new ['Class']
  82
  83     result = class.'name'()
  84     is(result, '', 'name() with no args returns class name, which is empty at first')
  85
  86     class.'name'('Alex')
  87     result = class.'name'()
  88     is(result, 'Alex', 'name() with args sets class name')
  89
  90     $I0 = 1        # hack for testing exceptions
  91     push_eh t_too_many_args
  92     class.'name'('Alice', 'Bob')
  93     $I0 = 0
  94     pop_eh
  95
  96   t_too_many_args:
  97     ok($I0, 'name() with too many args fails')
  98
  99     result = class.'get_namespace'()
 100     is(result, 'Alex', 'name() with args sets namespace too')
 101 .end
 102
 103
 104 # L<PDD15/Class PMC API/=item new>
 105 .sub 'new method'
 106     .local pmc class, result, attrib
 107     .local int isa_object
 108     class = new ['Class']
 109     result = class.'new'()
 110
 111     isa_ok(result, 'Object')
 112
 113     $I0 = 1
 114     push_eh t_non_attribute_key
 115     result = class.'new'('abc' => '123' )
 116     $I0 = 0
 117     pop_eh
 118
 119   t_non_attribute_key:
 120     ok($I0, 'new() with non-attribute key fails')
 121
 122     $I0 = 1
 123     class = new ['Class']
 124     class.'add_attribute'('foo')
 125     class.'add_attribute'('bar')
 126     result = class.'new'('foo' => 1, 'bar' => 2)
 127     attrib = getattribute result, 'foo'
 128     if attrib != 1 goto nok_3
 129     attrib = getattribute result, 'bar'
 130     if attrib != 2 goto nok_3
 131     goto ok_3
 132   nok_3:
 133     $I0 = 0
 134   ok_3:
 135     ok($I0, 'new() with key/value pairs sets attributes')
 136 .end
 137
 138
 139 # L<PDD15/Class PMC API/=item attributes>
 140 .sub 'attributes'
 141     .local pmc class, attribs
 142     .local int test_val
 143     class = new ['Class']
 144     attribs = class.'attributes'()
 145     test_val = isa attribs, 'Hash'
 146
 147     ok(test_val, 'attributes() returns a Hash')
 148
 149     test_val = attribs
 150     is(test_val, 0, 'New Class PMC has no attributes')
 151
 152     $I0 = 1
 153     push_eh ok_ro_accessor
 154     attribs = class.'attributes'( 'foo' )
 155     $I0 = 0
 156     pop_eh
 157
 158   ok_ro_accessor:
 159     ok($I0, 'attributes() is read-only accessor')
 160 .end
 161
 162
 163 # L<PDD15/Class PMC API/=item add_attribute>
 164 .sub 'add_attribute'
 165     .local pmc class, attribs
 166     .local int test_val
 167     class = new ['Class']
 168
 169     $I0 = 1
 170     push_eh t_no_args
 171     class.'add_attribute'()
 172     $I0 = 0
 173     pop_eh
 174
 175   t_no_args:
 176     ok($I0, 'add_attribute() with no args fails')
 177
 178     class.'add_attribute'( 'foo' )
 179     attribs = class.'attributes'()
 180     test_val = attribs
 181     is(test_val, 1, 'add_attribute() with valid single arg adds an attribute')
 182
 183     class.'add_attribute'( 'bar', 'Integer' )
 184     attribs = class.'attributes'()
 185     test_val = attribs
 186     is(test_val, 2, 'add_attribute() with valid args adds an attribute')
 187
 188     $I0 = 1
 189     push_eh t_existing_attribute
 190     class.'add_attribute'( 'foo', 'String' )
 191     $I0 = 0
 192     pop_eh
 193
 194   t_existing_attribute:
 195     ok($I0, 'add_attribute() with existing attribute name fails')
 196 .end
 197
 198
 199 # L<PDD15/Class PMC API>
 200 .sub 'set_attr/get_attr'
 201     .local pmc class, class_instance, attrib_in, attrib_out
 202     class = new ['Class']
 203     class.'name'("Test")
 204     class.'add_attribute'("foo")
 205     ok(1, 'created a class with one attribute')
 206
 207     class_instance = class.'new'()
 208     ok(1, 'instantiated the class')
 209
 210     attrib_in = new ['Integer']
 211     attrib_in = 42
 212     setattribute class_instance, "foo", attrib_in
 213     ok(1, 'set an attribute')
 214
 215     attrib_out = getattribute class_instance, "foo"
 216     is(attrib_out, 42, 'got an attribute')
 217 .end
 218
 219
 220 # L<PDD15/Class PMC API/=item add_method>
 221 .sub 'add_method'
 222     .local pmc class, attribs, test_attr_val, obj_inst
 223     .local int test_val
 224     class = new ['Class']
 225
 226     $I0 = 1
 227     push_eh t_no_args
 228     class.'add_method'()
 229     $I0 = 0
 230     pop_eh
 231
 232   t_no_args:
 233     ok($I0, 'add_method() with no args fails')
 234
 235     $I0 = 1
 236     push_eh t_one_arg
 237     class.'add_method'( 'foo' )
 238     $I0 = 0
 239     pop_eh
 240
 241   t_one_arg:
 242     ok($I0, 'add_method() with valid single arg fails')
 243
 244     # note this test depends on 'add_attribute' and 'attributes'
 245     class.'add_attribute'( 'foo', 'String' )
 246     attribs = class.'attributes'()
 247     attribs['foo'] = 'bar'
 248
 249     .const 'Sub' meth_to_add = 'foo'
 250
 251     class.'add_method'( 'foo', meth_to_add )
 252     attribs = class.'methods'()
 253     test_val = attribs
 254     is(test_val, 1, 'add_method() one method added')
 255
 256     test_val = exists attribs['foo']
 257     ok(test_val, 'add_method() method has correct name')
 258
 259     test_val = defined attribs['foo']
 260     ok(test_val, 'add_method() method is defined')
 261
 262     test_attr_val = attribs['foo']
 263     isa_ok(test_attr_val, 'Sub', 'add_method() with valid args adds a method')
 264
 265     .local string test_string_val
 266
 267     $I0 = 1
 268     push_eh t_class_meth
 269     test_string_val = class.'foo'()
 270     $I0 = 0
 271     pop_eh
 272
 273     is(test_string_val, 'bar', 'add_method() invoking method added to class works')
 274 t_class_meth:
 275     todo(0, 'add_method() invoking method added to class works', "classes don't seem to call methods yet")
 276
 277     obj_inst = class.'new'()
 278     test_string_val = obj_inst.'foo'()
 279     is(test_string_val, 'bar', 'add_method() invoking method added to class through instance works')
 280
 281
 282     $I0 = 1
 283     push_eh t_existing_method
 284     class.'add_method'( 'foo' )
 285     $I0 = 0
 286     pop_eh
 287
 288   t_existing_method:
 289     ok($I0, 'add_method() with existing method name fails')
 290 .end
 291
 292 .sub 'foo' :method
 293     .return ('bar')
 294 .end
 295
 296
 297 # L<PDD15/Class PMC API/=item parents>
 298 .sub 'parents'
 299     .local pmc class, parents
 300     .local int isa_parent
 301     class = new ['Class']
 302     parents = class.'parents'()
 303
 304     ## XXX is this really what's expected?
 305     isa_ok(parents, 'ResizablePMCArray', 'parents() returns a ResizablePMCArray')
 306 .end
 307 ## NOTE test that accessor is read-only
 308 ## NOTE figure out what parents the base Class has by default (if any)
 309 ## A: It has no parents by default. (Note, the parents stored in the 'parents'
 310 # attribute aren't the parents of Class, they're the parents of the class object
 311 # that is an instance of Class.)
 312
 313
 314 ## TODO add_parent
 315
 316
 317 # L<PDD15/Class PMC API/=item roles>
 318 .sub 'roles'
 319     .local pmc class, array
 320     .local int is_array
 321     class = new ['Class']
 322     array = class.'roles'()
 323
 324     ## XXX is this really what's expected?
 325     isa_ok(array, 'ResizablePMCArray', 'roles() returns a ResizablePMCArray')
 326 .end
 327 ## NOTE test that accessor is read-only
 328 ## NOTE figure out what roles the base Class has by default (if any)
 329 # A: None. See comment for parents().
 330
 331
 332 ## TODO add_role
 333
 334
 335 # L<PDD15/Class PMC API/=item inspect>
 336 .sub 'inspect'
 337     .local pmc class, result
 338     .local int test_val
 339
 340     class = new ['Class']
 341     class.'name'('foo')
 342     class.'add_attribute'('a')
 343
 344     result = class.'inspect'()
 345     ok(1, 'inspect() with no args called returns successfully')
 346
 347     test_val = elements result
 348     is(test_val, 7, 'inspect() returns correctly sized value')
 349
 350     result = class.'inspect'('name')
 351     is(result, 'foo', 'inspect() "name" param returns expected value')
 352
 353     result = class.'inspect'('attributes')
 354     test_val = elements result
 355     is(test_val, 1, 'inspect() "attributes" param returns correctly sized value')
 356 .end
 357 # TODO more tests
 358
 359
 360 .sub 'clone'
 361     .local pmc attrs, class, class_instance, test_pmc
 362     .local string test_name
 363     .local int test_val
 364
 365     attrs = new ['Hash']
 366     attrs['name'] = 'Monkey'
 367     class = new ['Class'], attrs
 368     class.'add_attribute'('banana')
 369     class_instance = class.'new'()
 370     ok(1, 'clone() created class Monkey and instantiated it')
 371
 372     class_instance = clone class
 373     ok(1, 'cloned class Monkey')
 374
 375     test_name = class_instance.'inspect'('name')
 376     is(test_name, '', 'clone() name is empty')
 377
 378     test_pmc = class_instance.'inspect'('namespace')
 379     $I0 = isnull test_pmc
 380     ok($I0, 'clone() namespace is null')
 381
 382     test_pmc = class_instance.'inspect'('attributes')
 383     test_val = elements test_pmc
 384     is(test_val, 1, 'clone() attribute survived cloning')
 385
 386     class_instance.'add_attribute'('jungle')
 387     ok(1, 'clone() can modify cloned class')
 388 .end
 389
 390
 391 .sub 'clone_pmc'
 392     .local pmc class, class_instance, monkey, mandrill, test_ns
 393     .local string test_string_val
 394     .local int num_elems
 395
 396     class = new ['Hash']
 397     class['name'] = 'Monkey2'
 398     class_instance = new ['Class'], class
 399     class_instance.'add_attribute'('banana')
 400     monkey = class_instance.'new'()
 401     ok(1, 'clone_pmc() created class Monkey and instantiated it')
 402
 403     class = new ['Hash']
 404     class['name'] = 'Mandrill'
 405     mandrill = clone class_instance, class
 406     ok(1, 'clone_pmc() cloned class Monkey with Hash argument')
 407
 408     test_string_val = mandrill.'inspect'('name')
 409     is(test_string_val, 'Mandrill', 'clone_pmc() name is new one set in the Hash')
 410
 411     test_ns = mandrill.'inspect'('namespace')
 412     test_string_val = test_ns
 413     is(test_string_val, 'Mandrill', 'clone_pmc() namespace is Mandrill too')
 414
 415     test_ns = mandrill.'inspect'('attributes')
 416     num_elems = elements test_ns
 417     is(num_elems, 1, 'clone_pmc() attribute survived cloning')
 418
 419     mandrill.'add_attribute'('jungle')
 420     ok(1, 'clone_pmc() can modify cloned class')
 421 .end
 422
 423
 424 .sub 'new with init hash'
 425     .local pmc class, init_hash, attrs, methods, meth_to_add, class_instance
 426     .local pmc attr_val, result
 427     init_hash = new ['Hash']
 428
 429     # We'll have some attributes...
 430     attrs = new ['ResizablePMCArray']
 431     attrs[0] = 'x'
 432     attrs[1] = 'y'
 433     init_hash['attributes'] = attrs
 434
 435     # And a method.
 436     methods = new ['Hash']
 437     meth_to_add = get_global 'add'
 438     methods['add'] = meth_to_add
 439     init_hash['methods'] = methods
 440
 441     class = new ['Class'], init_hash
 442     ok(1, 'new() created new class with attributes and methods supplied')
 443
 444     # Instantiate and try setting each attribute.
 445     class_instance = class.'new'()
 446     attr_val = new ['Integer']
 447     attr_val = 37
 448     setattribute class_instance, 'x', attr_val
 449     ok(1, 'new() set first attribute')
 450
 451     attr_val = new ['Integer']
 452     attr_val = 5
 453     setattribute class_instance, 'y', attr_val
 454     ok(1, 'new() set second attribute')
 455
 456     # Call method.
 457     result = class_instance.'add'()
 458     is(result, 42, 'new() added method returns expected value')
 459 .end
 460
 461 .sub add :method
 462     $P0 = getattribute self, "x"
 463     $P1 = getattribute self, "y"
 464     $P2 = new ['Integer']
 465     $P2 = $P0 + $P1
 466     .return($P2)
 467 .end
 468
 469
 470 # L<PDD15/Class PMC API/=item isa>
 471 .sub 'isa'
 472     .local pmc class
 473     class = new ['Class']
 474
 475     test_isa( class, 'Class', 1 )
 476     test_isa( class, 'Hash',  0 )
 477     test_isa( class, 'Foo',   0 )
 478 .end
 479
 480 .sub 'test_isa'
 481     .param pmc    obj
 482     .param string class
 483     .param int expected
 484     .local int isa_class
 485     .local string message
 486
 487     $I0 = 0
 488     message = 'isa() '
 489
 490     isa_class = obj.'isa'( class )
 491     if isa_class goto is_class
 492     message .= "The object isn't a "
 493     message .= class
 494     goto test
 495
 496   is_class:
 497     $I0 = 1
 498     message .= "The object is a "
 499     message .= class
 500
 501   test:
 502     is($I0, expected, message)
 503     .return()
 504 .end
 505
 506
 507 # L<PDD15/Class PMC API/=item does>
 508 .sub 'does'
 509     .local pmc class
 510     .local pmc attrs
 511     attrs = new ['Hash']
 512
 513     .local pmc red, green, blue
 514     attrs['name'] = 'Red'
 515     red           = new ['Role'], attrs
 516
 517     attrs['name'] = 'Green'
 518     green         = new ['Role'], attrs
 519
 520     attrs['name'] = 'Blue'
 521     blue          = new ['Role'], attrs
 522
 523     green.'add_role'( blue )
 524
 525     .local pmc color
 526     color = new ['Class']
 527
 528     test_does( color, 'Red', 0 )
 529
 530     color.'add_role'( red )
 531     test_does( color, 'Red', 1 )
 532
 533     color.'add_role'( green )
 534     test_does( color, 'Green', 1 )
 535     test_does( color, 'Blue', 1 )
 536
 537     test_does( color, 'Class', 1 )
 538 .end
 539
 540 .sub 'test_does'
 541     .param pmc    obj
 542     .param string role_name
 543     .param int expected
 544     .local int does_a_role
 545     .local string message
 546
 547     $I0 = 0
 548     message = 'does() '
 549
 550     does_a_role = obj.'does'( role_name )
 551     if does_a_role goto does_role
 552     message .= "The object doesn't "
 553     message .= role_name
 554     goto test
 555
 556   does_role:
 557     $I0 = 1
 558     message .= "The object does "
 559     message .= role_name
 560
 561   test:
 562     is($I0, expected, message)
 563     .return()
 564 .end
 565
 566
 567 # L<PDD15/Class PMC API/=item does>
 568 .sub 'more does' # RT #42974
 569     .local pmc attrs
 570     attrs = new ['Hash']
 571
 572     .local pmc red, green, blue
 573     attrs['name'] = 'Red'
 574     red           = new ['Role'], attrs
 575
 576     attrs['name'] = 'Green'
 577     green         = new ['Role'], attrs
 578
 579     attrs['name'] = 'Blue'
 580     blue          = new ['Role'], attrs
 581
 582     green.'add_role'( blue )
 583
 584     .local pmc color
 585     color = new ['Class']
 586
 587     $S0 = 'Red'
 588     $I0 = color.'does'($S0)
 589     is($I0, 0, 'does not Red')
 590
 591     color.'add_role'( red )
 592     $I0 = color.'does'($S0)
 593     is($I0, 1, 'does Red')
 594 .end
 595
 596 .sub 'anon_inherit'
 597     $P0 = new 'Class'
 598     $P1 = new 'Class'
 599     $P2 = new 'Class'
 600     addparent $P2, $P0
 601     addparent $P2, $P1
 602     ok(1, 'inheritance of two different anonymous classes works')
 603 .end
 604
 605 # Local Variables:
 606 #   mode: pir
 607 #   fill-column: 100
 608 # End:
 609 # vim: expandtab shiftwidth=4 ft=pir: