t/oo/new.t

   1 #!./parrot
   2 # Copyright (C) 2007-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/new.t - Test OO instantiation
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/new.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests OO features related to instantiating new objects.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'except_types.pasm'
  21     .include 'test_more.pir'
  22     plan(111)
  23
  24     instantiate_from_class_object()
  25     manually_create_anonymous_class_object()
  26     manually_create_named_class_object()
  27     instantiate_from_class_object_method()
  28     instantiate_from_string_name()
  29     instantiate_from_string_register_name()
  30     instantiate_from_string_PMC_name()
  31     instantiate_from_key_name()
  32     instantiate_from_key_PMC_name()
  33     create_and_instantiate_from_array_of_names()
  34     only_string_arrays_work_for_creating_classes()
  35     instantiate_from_class_object_with_init()
  36     instantiate_from_string_name_with_init()
  37     instantiate_from_string_register_name_with_init()
  38     instantiate_from_string_PMC_name_with_init()
  39     instantiate_from_array_of_names_with_init()
  40     instantiate_from_key_name_with_init()
  41     create_class_namespace_initializer()
  42     regression_test_instantiate_class_within_different_namespace()
  43     get_class_retrieves_a_high_level_class_object()
  44     get_class_retrieves_a_proxy_class_object()
  45     get_class_retrieves_a_class_object_that_doesnt_exist()
  46     instantiate_class_from_invalid_key()
  47 .end
  48
  49
  50 #
  51 # Utility sub
  52 #
  53 .sub _test_instance
  54     .param pmc obj
  55     .param string in_str
  56
  57     # Set up local variables
  58     .local pmc key_pmc
  59     .local string class_name
  60
  61     key_pmc = new 'Key'
  62     $P0 = split ' ', in_str
  63     $S0 = shift $P0
  64     $I1 = 1
  65     key_pmc    = $S0
  66     class_name = $S0
  67
  68   LOOP:
  69     $I0 = elements $P0
  70     if $I0 == 0 goto BEGIN_TEST
  71     $S1 = shift $P0
  72     $P1 = new 'Key'
  73     $P1 = $S1
  74     push key_pmc, $P1
  75     concat class_name, ';'
  76     concat class_name, $S1
  77     $I1 += 1
  78     goto LOOP
  79
  80     # Start testing
  81   BEGIN_TEST:
  82     .local string typeof_message
  83     typeof_message = concat 'New instance is of type: ', class_name
  84     $S1 = typeof obj
  85     is($S1, class_name, typeof_message)
  86
  87     isa_ok(obj, 'Object')
  88
  89     .local string keypmc_message
  90     $S2 = get_repr key_pmc
  91     keypmc_message = concat 'The object isa ', $S2
  92     $I2 = isa obj, key_pmc
  93     ok($I2, keypmc_message)
  94
  95     unless $I1 == 1 goto END_TEST
  96     isa_ok(obj, class_name)
  97
  98   END_TEST:
  99     .return()
 100 .end
 101
 102
 103 #############################################################################
 104
 105
 106 .sub instantiate_from_class_object
 107     ok(1, "Instantiate from class object")
 108     $P1 = newclass 'Foo1'
 109     $S1 = typeof $P1
 110     is($S1, 'Class', '`newclass "Foo"` creates a Class PMC')
 111     isa_ok($P1, 'Class')
 112
 113     $P2 = new $P1
 114     _test_instance($P2, 'Foo1')
 115 .end
 116
 117
 118 .sub manually_create_anonymous_class_object
 119     ok(2, "Manually create anonymous class object")
 120     $P1 = new 'Class'
 121     $S1 = typeof $P1
 122     is($S1, 'Class', 'New anonymous class creates a Class PMC')
 123     isa_ok($P1, 'Class')
 124
 125     $P2 = new $P1
 126     $S1 = typeof $P2
 127     is($S1, '', 'New instance is of type ""')
 128     isa_ok($P2, 'Object')
 129
 130     $I3 = isa $P2, ''
 131     is($I3, 0, '"isa" will not match an empty type')
 132     $I3 = isa $P2, 'Foo'
 133     is($I3, 0, '"isa" will not match a random type')
 134 .end
 135
 136
 137 .sub manually_create_named_class_object
 138     ok(3, "Manually create named class object")
 139     $P1 = new 'Class'
 140     $P1.'name'('Foo2')
 141     $S1 = typeof $P1
 142     is($S1, 'Class', 'new named class creates a "Class" PMC')
 143     isa_ok($P1, 'Class')
 144
 145     $P2 = new $P1
 146     _test_instance($P2, 'Foo2')
 147 .end
 148
 149
 150 .sub instantiate_from_class_object_method
 151     ok(4, "Instantiate from class object 'new' method")
 152     $P1 = newclass 'Foo3'
 153
 154     $P2 = $P1.'new'()
 155     _test_instance($P2, 'Foo3')
 156 .end
 157
 158
 159 .sub instantiate_from_string_name
 160     ok(5, "Instantiate from string name")
 161     $P1 = newclass 'Foo4'
 162
 163     $P2 = new 'Foo4'
 164     _test_instance($P2, 'Foo4')
 165 .end
 166
 167
 168 .sub instantiate_from_string_register_name
 169     ok(6, "Instantiate from string register name")
 170     $P1 = newclass 'Foo5'
 171
 172     $S1 = 'Foo5'
 173     $P2 = new $S1
 174     _test_instance($P2, 'Foo5')
 175 .end
 176
 177
 178 .sub instantiate_from_string_PMC_name
 179     ok(7, "Instantiate from string PMC name")
 180     $P1 = newclass 'Foo6'
 181
 182     $P3 = new 'String'
 183     $P3 = 'Foo6'
 184     $P2 = new $P3
 185     _test_instance($P2, 'Foo6')
 186 .end
 187
 188
 189 .sub instantiate_from_key_name
 190     ok(8, "Instantiate from Key name")
 191     $P1 = newclass ['Foo';'Bar1']
 192     $S1 = typeof $P1
 193     is($S1, 'Class', "`newclass ['Foo';'Bar1']` creates a Class PMC")
 194     isa_ok($P1, 'Class')
 195
 196     $P2 = new $P1
 197     _test_instance($P2, 'Foo Bar1')
 198 .end
 199
 200
 201 .sub instantiate_from_key_PMC_name
 202     ok(9, "Instantiate from Key PMC name")
 203     $P1 = newclass ['Foo';'Bar2']
 204
 205     $P3 = new 'Key'
 206     $P3 = 'Foo'
 207     $P4 = new 'Key'
 208     $P4 = 'Bar2'
 209     push $P3, $P4
 210
 211     $P2 = new $P3
 212     _test_instance($P2, 'Foo Bar2')
 213 .end
 214
 215
 216 .sub create_and_instantiate_from_array_of_names
 217     ok(10, "Create and instantiate from ResizableStringArray")
 218     $P0 = split ' ', 'Foo Bar3'
 219     $P1 = newclass $P0
 220     $S1 = typeof $P1
 221     is($S1, 'Class', "`newclass some_string_array` creates a Class PMC")
 222     isa_ok($P1, 'Class')
 223
 224     $P2 = new $P0
 225     _test_instance($P2, 'Foo Bar3')
 226 .end
 227
 228
 229 .sub only_string_arrays_work_for_creating_classes
 230     ok(11, 'Create a class via a ResizablePMCArray')
 231     .local pmc eh
 232     .local string message
 233     $P0  = new 'ResizablePMCArray'
 234     $P10 = new 'String'
 235     $P10 = 'Foo'
 236     $P11 = new 'String'
 237     $P11 = 'Bar4'
 238     $P0.'push'($P10)
 239     $P0.'push'($P11)
 240
 241   try:
 242     eh = new 'ExceptionHandler'
 243     eh.'handle_types'(.EXCEPTION_INVALID_OPERATION)
 244     set_addr eh, catch
 245
 246     push_eh eh
 247     $P1 = newclass $P0
 248     $I0 = 1
 249     goto finally
 250
 251   catch:
 252     .local pmc exception
 253     .get_results(exception)
 254     message = exception['message']
 255     $I0 = 0
 256
 257   finally:
 258     pop_eh
 259     nok($I0, "Exception caught for ...")
 260     is(message, 'Invalid class name key in init_pmc for Class', 'Invalid class name key')
 261 .end
 262
 263
 264 .sub instantiate_from_class_object_with_init
 265     ok(12, 'Instantiate from Class object, with init')
 266     $P1 = newclass 'Foo7'
 267     addattribute $P1, 'data'
 268     $P3 = new 'Hash'
 269     $P4 = new 'String'
 270     $P4 = 'data for Foo7'
 271     $P3['data'] = $P4
 272
 273     $P2 = new $P1, $P3
 274     _test_instance($P2, 'Foo7')
 275
 276     $P5 = getattribute $P2, 'data'
 277     is($P5, 'data for Foo7', 'class attribute retrieved via the instance')
 278 .end
 279
 280
 281 .sub instantiate_from_string_name_with_init
 282     ok(13, 'Instantiate from string name, with init')
 283     $P1 = newclass 'Foo8'
 284     addattribute $P1, 'data'
 285     $P3 = new 'Hash'
 286     $P4 = new 'String'
 287     $P4 = 'data for Foo8'
 288     $P3['data'] = $P4
 289
 290     $P2 = new 'Foo8', $P3
 291     _test_instance($P2, 'Foo8')
 292
 293     $P5 = getattribute $P2, 'data'
 294     is($P5, 'data for Foo8', 'class attribute retrieved via the instance')
 295 .end
 296
 297
 298 .sub instantiate_from_string_register_name_with_init
 299     ok(14, 'Instantiate from string register name, with init')
 300     $P1 = newclass 'Foo9'
 301     addattribute $P1, 'data'
 302     $P3 = new 'Hash'
 303     $P4 = new 'String'
 304     $P4 = 'data for Foo9'
 305     $P3['data'] = $P4
 306
 307     $S1 = 'Foo9'
 308     $P2 = new $S1, $P3
 309     _test_instance($P2, 'Foo9')
 310
 311     $P5 = getattribute $P2, 'data'
 312     is($P5, 'data for Foo9', 'class attribute retrieved via the instance')
 313 .end
 314
 315
 316 .sub instantiate_from_string_PMC_name_with_init
 317     ok(15, 'Instantiate from string PMC name, with init')
 318     $P1 = newclass 'Foo10'
 319     addattribute $P1, 'data'
 320     $P3 = new 'Hash'
 321     $P4 = new 'String'
 322     $P4 = 'data for Foo10'
 323     $P3['data'] = $P4
 324
 325     $P6 = new 'String'
 326     $P6 = 'Foo10'
 327     $P2 = new $P6, $P3
 328     _test_instance($P2, 'Foo10')
 329
 330     $P5 = getattribute $P2, 'data'
 331     is($P5, 'data for Foo10', 'class attribute retrieved via the instance')
 332 .end
 333
 334
 335 .sub instantiate_from_array_of_names_with_init
 336     ok(16, 'Instantiate from string array, with init')
 337     $P0 = split ' ', 'Foo Bar5'
 338     $P1 = newclass $P0
 339     addattribute $P1, 'data'
 340     $P3 = new 'Hash'
 341     $P4 = new 'String'
 342     $P4 = 'data for Foo;Bar5'
 343     $P3['data'] = $P4
 344
 345     $P2 = new $P0, $P3
 346
 347     $S1 = typeof $P2
 348     _test_instance($P2, 'Foo Bar5')
 349
 350     $P5 = getattribute $P2, 'data'
 351     is($P5, 'data for Foo;Bar5', 'class attribute retrieved via the instance')
 352 .end
 353
 354
 355 .sub instantiate_from_key_name_with_init
 356     ok(17, 'Instantiate from Key name, with init')
 357     $P1 = newclass ['Foo';'Bar6']
 358     addattribute $P1, 'data'
 359
 360     $P3 = new 'Hash'
 361     $P4 = new 'String'
 362     $P4 = 'data for Foo;Bar6'
 363     $P3['data'] = $P4
 364
 365     $P2 = new ['Foo';'Bar6'], $P3
 366     _test_instance($P2, 'Foo Bar6')
 367
 368     $P5 = getattribute $P2, 'data'
 369     is($P5, 'data for Foo;Bar6', 'class attribute retrieved via the instance')
 370 .end
 371
 372
 373 .sub create_class_namespace_initializer
 374     .local pmc ns
 375     ns = get_namespace ['Foo';'Bar7']
 376     $P0 = new 'Class', ns
 377
 378     $P1 = new ['Foo';'Bar7']
 379     $S0 = $P1.'blue'()
 380     is($S0, 'foo_bar7 blue', 'Create class namespace initializer')
 381 .end
 382
 383 .namespace [ 'Foo';'Bar7' ]
 384 .sub blue :method
 385     .return('foo_bar7 blue')
 386 .end
 387
 388 .namespace []
 389
 390
 391 .sub regression_test_instantiate_class_within_different_namespace
 392     $P0 = newclass 'Foo11'
 393     $P0 = newclass 'Bar11'
 394
 395     $P1 = new 'Foo11'
 396     $S0 = $P1.'blue'()
 397     is($S0, 'foo11 blue bar11 blue', 'Regression test: instantiate class within different namespace')
 398 .end
 399
 400 .namespace [ 'Foo11' ]
 401 .sub blue :method
 402     $P0 = new 'Bar11'
 403     $S0 = $P0.'blue'()
 404     $S0 = concat 'foo11 blue ', $S0
 405     .return($S0)
 406 .end
 407
 408 .namespace [ 'Bar11' ]
 409 .sub blue :method
 410     .return('bar11 blue')
 411 .end
 412
 413 .namespace []
 414
 415
 416 .sub get_class_retrieves_a_high_level_class_object
 417     ok(20, 'get_class retrieves a high level class object')
 418     $P0 = newclass 'Foo12'
 419     $S1 = typeof $P0
 420     is($S1, 'Class',"`newclass 'Foo12' returns a Class PMC`")
 421
 422     $P1 = get_class 'Foo12'
 423     $S1 = typeof $P1
 424     is($S1, 'Class',"`get_class 'Foo12' returns a Class PMC`")
 425
 426     $P2 = new $P1
 427     _test_instance($P2, 'Foo12')
 428 .end
 429
 430
 431 .sub get_class_retrieves_a_proxy_class_object
 432     ok(21, 'get_class retrieves a proxy class object')
 433     $P1 = get_class 'String'
 434     $S1 = typeof $P1
 435     is($S1, 'PMCProxy', "`get_class 'String'` returns a PMCProxy PMC")
 436
 437     $P2 = new $P1
 438     $S1 = typeof $P2
 439     is($S1, 'String', 'Instantiating the proxy returns a String PMC')
 440 .end
 441
 442
 443 .sub get_class_retrieves_a_class_object_that_doesnt_exist
 444     ok(22, 'get_class retrieves a class object that does not exist')
 445     .local int murple_not_defined
 446     murple_not_defined = 1
 447     $P1 = get_class 'Murple'
 448     if null $P1 goto not_defined
 449     murple_not_defined = 0
 450
 451   not_defined:
 452     ok(murple_not_defined, '"Murple" class is not defined')
 453 .end
 454
 455
 456 .sub instantiate_class_from_invalid_key
 457     ok(23, 'Instantiate a class from invalid Key PMC')
 458     .local pmc eh
 459     .local string message
 460
 461   try:
 462     eh = new 'ExceptionHandler'
 463     eh.'handle_types'(.EXCEPTION_NO_CLASS)
 464     set_addr eh, catch
 465
 466     push_eh eh
 467     $P0 = new [ 'Foo'; 'Bar'; 'Baz' ]
 468     $I0 = 1
 469     goto finally
 470
 471   catch:
 472     .local pmc exception
 473     .get_results(exception)
 474     message = exception['message']
 475     $I0 = 0
 476
 477   finally:    pop_eh
 478     nok($I0, 'Exception caught for ...')
 479     is(message, "Class '[ 'Foo' ; 'Bar' ; 'Baz' ]' not found", 'Class not found')
 480 .end
 481
 482
 483 # Local Variables:
 484 #   mode: pir
 485 #   fill-column: 100
 486 # End:
 487 # vim: expandtab shiftwidth=4 ft=pir: