t/oo/root_new.t

   1 #! parrot
   2 # Copyright (C) 2007-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/root_new.t - Test OO instantiation via root_new
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/root_new.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests OO features related to instantiating new objects
  16 via the C<root_new> opcode.
  17
  18 =cut
  19
  20 .sub main :main
  21     .include 'except_types.pasm'
  22     .include 'test_more.pir'
  23     plan(6)
  24
  25     instantiate_from_key_pmc()
  26     .const 'Sub' test2 = 'instantiate_from_key_pmc_in_foreign_hll'
  27     test2()
  28 .end
  29
  30
  31 #
  32 # Utility sub
  33 #
  34 .sub _test_instance
  35     .param pmc obj
  36     .param string in_str
  37
  38     # Set up local variables
  39     .local pmc key_pmc
  40     .local string class_name
  41
  42     key_pmc = new 'Key'
  43     $P0 = split ' ', in_str
  44     $S0 = shift $P0
  45     $I1 = 1
  46     key_pmc    = $S0
  47     class_name = $S0
  48
  49   LOOP:
  50     $I0 = elements $P0
  51     if $I0 == 0 goto BEGIN_TEST
  52     $S1 = shift $P0
  53     $P1 = new 'Key'
  54     $P1 = $S1
  55     push key_pmc, $P1
  56     concat class_name, ';'
  57     concat class_name, $S1
  58     $I1 += 1
  59     goto LOOP
  60
  61     # Start testing
  62   BEGIN_TEST:
  63     .local string typeof_message
  64     typeof_message = concat 'New instance is of type: ', class_name
  65     $S1 = typeof obj
  66     is($S1, class_name, typeof_message)
  67
  68     .local string keypmc_message
  69     $S2 = get_repr key_pmc
  70     keypmc_message = concat 'The object isa ', $S2
  71     $I2 = isa obj, key_pmc
  72     ok($I2, keypmc_message)
  73
  74     unless $I1 == 1 goto END_TEST
  75     isa_ok(obj, class_name)
  76
  77   END_TEST:
  78     .return()
  79 .end
  80
  81
  82 #############################################################################
  83
  84 .sub instantiate_from_key_pmc
  85     $P0 = root_new ['parrot';'Integer']
  86     _test_instance($P0, 'Integer')
  87 .end
  88
  89
  90 .HLL 'foreign'
  91 .sub instantiate_from_key_pmc_in_foreign_hll
  92     $P0 = root_new ['parrot';'Integer']
  93     _test_instance($P0, 'Integer')
  94 .end
  95