t/pmc/env.t

   1 #! parrot
   2 # Copyright (C) 2001-2008, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/env.t - System Environment
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/env.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the C<Env> PMC.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21     plan(16)
  22
  23     all_envs_are_identical()
  24     setenv_getenv()
  25     all_envs_are_the_same()
  26     gone_delete()
  27     iterate()
  28     exists_delete()
  29     is_interface_done()
  30     get_integer()
  31     oob_query()
  32 .end
  33
  34 .sub all_envs_are_identical
  35     $P0 = new ['Env']
  36     $P1 = new ['Env']
  37     eq_addr $P0, $P1, ok
  38     ok(0, "all Envs aren't identical")
  39     goto end
  40 ok:
  41     ok(1, "all Envs are identical")
  42 end:
  43 .end
  44
  45 .sub setenv_getenv
  46     $P0 = new ['Env']
  47     set $P0['PARROT_TMP'], 'hello polly'
  48     set $S0, $P0['PARROT_TMP']
  49     is($S0, 'hello polly', 'getenv and setenv work with string keys')
  50     delete $P0['PARROT_TMP']
  51
  52     $P1 = new ['Key']
  53     set $P1, "PARROT_TMP"
  54     $P2 = new ['String']
  55     set $P2, "Foobar"
  56     $P3 = new ['String']
  57     set $P0[$P1], $P2
  58     set $P3, $P0[$P1]
  59     is($P3, "Foobar", "getenv and setenv work with PMC keys")
  60     delete $P0['PARROT_TMP']
  61
  62     set $S0, $P0[""]
  63     is($S0, '', 'getenv works with a null key')
  64 .end
  65
  66 .sub all_envs_are_the_same
  67     $P0 = new ['Env']
  68     set $P0['PARROT_TMP'], 'hello polly'
  69     set $S0, $P0['PARROT_TMP']
  70     $P1 = new ['Env']
  71     set $S1, $P1['PARROT_TMP']
  72     is($S0, $S1, 'all envs are the same')
  73     delete $P0['PARROT_TMP']
  74 .end
  75
  76 .sub gone_delete
  77     $P0 = new ['Env']
  78     set $P0['PARROT_TMP'], 'hello polly'
  79     exists $I0, $P0['PARROT_TMP']
  80     if $I0, ok1
  81     ok(0, "expected element doesn't exist")
  82 ok1:
  83     ok(1, 'expected element exists')
  84     delete $P0['PARROT_TMP']
  85     set $S0, $P0['PARROT_TMP']
  86     unless $S0, ok2
  87     ok(0, 'deleted element exists')
  88 ok2:
  89     ok(1, 'deleted element is deleted')
  90 .end
  91
  92 .sub iterate
  93     $P0 = new ['Env']
  94     set $P0["PARROT_1"], "hello"
  95     set $P0["PARROT_2"], "polly"
  96     iter $P1, $P0
  97     set $I0, 0
  98 loop:
  99     unless $P1, loopend
 100     shift $S2, $P1
 101     eq $S2, "PARROT_1", gotit
 102     eq $S2, "PARROT_2", gotit
 103     branch notit
 104 gotit:
 105     inc $I0
 106 notit:
 107     branch loop
 108 loopend:
 109     is($I0, 2, 'assigned env vars showed up in the iterator')
 110 .end
 111
 112     # This will not work on our unsetenv implementation
 113     #skip( "no native unsetenv", 1 ) unless $PConfig{"unsetenv"};
 114 .sub exists_delete
 115
 116     .include "iglobals.pasm"
 117     .local pmc config_hash, interp
 118     interp = getinterp
 119     config_hash = interp[.IGLOBALS_CONFIG_HASH]
 120     $I0 = config_hash["unsetenv"]
 121
 122     unless $I0 goto no_unsetenv
 123
 124     $P0 = new ['Env']
 125     set $P0['PARROT_TMP'], 'hello polly'
 126     exists $I0, $P0['PARROT_TMP']
 127     ok( $I0, "set env var stays set")
 128     delete $P0["PARROT_TMP"]
 129     exists $I0, $P0["PARROT_TMP"]
 130     is($I0, 0, "deleted env var stays deleted")
 131     goto end
 132
 133 no_unsetenv:
 134     skip(1, "no native unsetenv")
 135     skip(1, "no native unsetenv")
 136 end:
 137 .end
 138
 139 .sub is_interface_done
 140     .local pmc pmc1
 141     pmc1 = new ['Env']
 142     .local int bool1
 143
 144     does bool1, pmc1, 'hash'
 145     ok(bool1, 'does Hash')
 146
 147     does bool1, pmc1, 'scalar'
 148     is(bool1, 0, "doesn't do Scalar")
 149
 150     does bool1, pmc1, 'no_interface'
 151     is(bool1, 0, "doesn't do no_interface")
 152 .end
 153
 154 .sub get_integer
 155     .local pmc env
 156     .local int int_before, int_after, int_diff
 157     .local num num_before, num_after, num_diff
 158
 159     # add three more keys in env
 160     env = new ['Env']
 161     num_before = env
 162     int_before = env
 163     env["PARROT_TMP_ADD_1"] = "tmp_add_1"
 164     env["PARROT_TMP_ADD_2"] = "tmp_add_2"
 165     env["PARROT_TMP_ADD_3"] = "tmp_add_3"
 166     num_after = env
 167     int_after = env
 168     num_diff = num_after - num_before
 169     int_diff = int_after - int_before
 170     is(int_diff, 3, "get_integer seems sane")
 171     is(num_diff, 3, "get_number seems sane")
 172
 173     #clean up the environment
 174     delete env['PARROT_TMP_ADD_1']
 175     delete env['PARROT_TMP_ADD_2']
 176     delete env['PARROT_TMP_ADD_3']
 177 .end
 178
 179 ## RT #50186 - shouldn't segfault
 180 .sub oob_query
 181     $P0 = new ['Env']
 182     set $S0, $P0[999]
 183     is($S0, '', 'no segfault')
 184 .end
 185
 186 # Local Variables:
 187 #   mode: pir
 188 #   cperl-indent-level: 4
 189 #   fill-column: 100
 190 # End:
 191 # vim: expandtab shiftwidth=4 ft=pir: