t/pmc/undef.t

   1 #!./parrot
   2 # Copyright (C) 2001-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/undef.t - Undef PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/undef.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests mainly morphing undef to other types.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21
  22     plan(24)
  23
  24     morph_to_string()
  25     undef_pmc_is_false()
  26     undef_pmc_is_not_defined()
  27     undef_pmc_morph_to_string()
  28     undef_pmc_morph_to_integer()
  29     undef_pmc_morph_to_float()
  30     string_pmc_morph_to_undef()
  31     undef_pmc_set_to_integer_native()
  32     undef_pmc_isa_after_assignment()
  33     check_whether_interface_is_done()
  34     verify_clone_works()
  35     undef_equals_undef()
  36     set_undef_to_object()
  37 .end
  38
  39 .sub morph_to_string
  40         new $P0, ['String']
  41         new $P1, ['Undef']
  42         set $P0, "foo"
  43         concat  $P1, $P0, $P0
  44         is( $P1, 'foofoo', 'morphed to string' )
  45 .end
  46
  47 .sub undef_pmc_is_false
  48     .local pmc pmc1
  49     pmc1 = new ['Undef']
  50     if pmc1 goto PMC1_IS
  51       ok( 1, 'PMC Undef created by new is false' )
  52       goto logical_not
  53     PMC1_IS:
  54     ok( 0, 'PMC Undef created by new is false' )
  55
  56   logical_not:
  57     unless pmc1 goto logical_not_passed
  58     ok( 0, 'logical_not of PMC Undef created by new is false' )
  59     goto done
  60   logical_not_passed:
  61     ok( 1, 'logical_not of PMC Undef created by new is true' )
  62
  63   done:
  64 .end
  65
  66 .sub undef_pmc_is_not_defined
  67     .local pmc pmc1
  68     pmc1 = new ['Undef']
  69     .local int is_defined
  70     is_defined = defined pmc1
  71     if is_defined goto PMC1_IS_DEFINED
  72       ok( 1, 'PMC Undef created by new is not defined' )
  73       .return()
  74     PMC1_IS_DEFINED:
  75     ok( 0, 'PMC Undef created by new is not defined' )
  76 .end
  77
  78 .sub undef_pmc_morph_to_string
  79     .local pmc pmc1
  80     pmc1 = new ['Undef']
  81     $S1 = pmc1
  82     is( $S1, '', 'PMC Undef is empty string' )
  83 .end
  84
  85 .sub undef_pmc_morph_to_integer
  86     .local pmc pmc1
  87     pmc1 = new ['Undef']
  88     .local int int1
  89     int1 = pmc1
  90     is( int1, 0, 'PMC Undef as integer is zero' )
  91
  92     .local int int2
  93     int2 = -7777777
  94     int2 += int1
  95     is( int2, -7777777, 'PMC Undef in addition is zero' )
  96 .end
  97
  98 .sub undef_pmc_morph_to_float
  99     .local pmc pmc1
 100     pmc1 = new ['Undef']
 101     .local int int1
 102     int1 = pmc1
 103     .local num float1
 104     float1 = -7777777e-3
 105     float1 += int1
 106     is( float1, -7777.777000, 'PMC Undef morph to int then float' )
 107 .end
 108
 109 .sub string_pmc_morph_to_undef
 110     .local pmc pmc1
 111     pmc1 = new ['String']
 112     $P0 = get_class 'Undef'
 113     morph pmc1, $P0
 114     $S1 = typeof pmc1
 115     is( $S1, 'Undef', 'PMC String morph to undef' )
 116 .end
 117
 118 .sub undef_pmc_set_to_integer_native
 119     .local pmc pmc1
 120     pmc1 = new ['Undef']
 121     pmc1 = -88888888
 122     is( pmc1, -88888888, 'PMC Undef set to int gives int' )
 123
 124     .local int pmc1_is_a
 125     pmc1_is_a = isa pmc1, "Integer"
 126     ok( pmc1_is_a, 'PMC Undef set to int isa Integer' )
 127 .end
 128
 129 .sub undef_pmc_isa_after_assignment
 130     .local pmc pmc1
 131     pmc1 = new ['Undef']
 132     .local int pmc1_is_a
 133
 134     pmc1_is_a = isa pmc1, "Undef"
 135     ok( pmc1_is_a, 'PMC Undef isa Undef' )
 136
 137     pmc1_is_a = isa pmc1, "default"
 138     is( pmc1_is_a, 0, 'PMC Undef is not default' )
 139
 140     pmc1_is_a = isa pmc1, "Default"
 141     is( pmc1_is_a, 0, 'PMC Undef is not Default' )
 142
 143     pmc1_is_a = isa pmc1, "scalar"
 144     is( pmc1_is_a, 0, 'PMC Undef is not scalar' )
 145
 146     pmc1_is_a = isa pmc1, "Scalar"
 147     is( pmc1_is_a, 0, 'PMC Undef is not Scalar' )
 148 .end
 149
 150 .sub check_whether_interface_is_done
 151     .local pmc pmc1
 152     pmc1 = new ['Undef']
 153     .local int bool1
 154
 155     does bool1, pmc1, "scalar"
 156     is( bool1, 1, 'PMC Undef does scalar' )
 157
 158     does bool1, pmc1, "no_interface"
 159     is( bool1, 0, 'PMC Undef does not do no_interface' )
 160 .end
 161
 162 .sub verify_clone_works
 163     $P1 = new ['Undef']
 164     $P2 = clone $P1
 165     $S0 = typeof $P2
 166     is( $S0, 'Undef', 'PMC Undef clone is an Undef' )
 167 .end
 168
 169 .sub undef_equals_undef
 170     $P1 = new ['Undef']
 171     $P2 = new ['Undef']
 172     if $P1 == $P2 goto ok
 173         ok( 0, 'Undef == Undef' )
 174         .return()
 175   ok:
 176     ok( 1, 'Undef == Undef' )
 177 .end
 178
 179 .sub set_undef_to_object
 180     $P0 = new "Undef"
 181     $P1 = get_class 'Integer'
 182     $P2 = new 'Integer'
 183     assign $P0, $P2
 184     $I0 = isa $P0, $P1
 185     ok( $I0, 'Assign Integer to Undef' )
 186
 187     $P0 = new "Undef"
 188     $P1 = newclass "HI"
 189     $P2 = new $P1
 190     assign $P0, $P2
 191     $I0 = isa $P0, $P1
 192     ok( $I0, 'Assign Object to Undef' )
 193
 194     $S0 = $P0
 195     is( $S0, 'A string', '... and the right object' )
 196
 197     $P0 = new "Undef"
 198     $P1 = subclass 'ResizablePMCArray', 'FooRPA'
 199     $P2 = new $P1
 200     assign $P0, $P2
 201     $I0 = isa $P0, $P1
 202     ok( $I0, 'Assign Object with PMC parent to Undef' )
 203
 204     # TODO: Needs tests to verify that the values and metadata are preserved
 205     #       across the assignment
 206 .end
 207
 208 .namespace [ 'HI' ]
 209
 210 .sub get_string :vtable :method
 211     .return( 'A string' )
 212 .end
 213
 214 # Local Variables:
 215 #   mode: pir
 216 #   fill-column: 100
 217 # End:
 218 # vim: expandtab shiftwidth=4 ft=pir: