t/op/string_mem.t

   1 #!./parrot
   2 # Copyright (C) 2008-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/string-mem.t - test memory representation related string operations
   8
   9
  10 =head1 SYNOPSIS
  11
  12     % prove t/op/string_mem.t
  13
  14 =head1 DESCRIPTION
  15
  16 Tests string ops related to low-level representation of strings, such as:
  17
  18 =over
  19
  20 =item *
  21
  22 stringinfo
  23
  24 =item *
  25
  26 pin/unpin
  27
  28 =back
  29
  30 =cut
  31
  32 .include 'stringinfo.pasm'
  33 .include 'interpinfo.pasm'
  34
  35 .const int TESTS = 7
  36
  37 .sub _main :main
  38     .include 'test_more.pir'
  39
  40     plan(TESTS)
  41
  42     test_stringinfo()
  43     $S0 = interpinfo .INTERPINFO_GC_SYS_NAME
  44     if $S0 == "inf" goto dont_run_hanging_tests
  45     test_pin_unpin()
  46     goto test_end
  47   dont_run_hanging_tests:
  48     ok(1, "#TODO - Test disabled on gc_inf")
  49     ok(1, "#TODO - Test disabled on gc_inf")
  50   test_end:
  51 .end
  52
  53 .sub test_stringinfo
  54
  55     $S1 = "Hello, world"
  56     $S0 = $S1
  57     $I0 = stringinfo $S0, .STRINGINFO_STRSTART
  58     $I1 = stringinfo $S1, .STRINGINFO_STRSTART
  59     is($I0, $I1, "stringinfo - test STRSTART can see COW in action")
  60
  61     $I0 = stringinfo $S0, .STRINGINFO_HEADER
  62     $I1 = stringinfo $S1, .STRINGINFO_HEADER
  63     is($I0, $I1, "stringinfo - STRHEADER on full COW strings keeps same value")
  64
  65     $S2 = substr $S0, 7
  66     is($S2, "world", "sanity check")
  67     $I4 = stringinfo $S0, .STRINGINFO_STRSTART
  68     $I2 = stringinfo $S2, .STRINGINFO_STRSTART
  69     $I3 = $I2 - $I4
  70     is($I3, 7, "stringinfo - STRSTART can see COW in action")
  71
  72     $I2 = stringinfo $S2, .STRINGINFO_HEADER
  73     isnt($I0, $I2, "stringinfo - STRHEADER on different COW strings same value")
  74 .end
  75
  76 .sub test_pin_unpin
  77
  78     .local int init, before, after
  79
  80     $S0 = 'life'
  81     $S1 = 'life'
  82     $S2 = 'life'
  83     $S3 = 'life'
  84     $S4 = 'life'
  85     $S5 = 'life'
  86     $S6 = 'love'
  87     $S7 = 'life'
  88     $S8 = 'life'
  89     $S9 = 'life'
  90
  91     pin $S6
  92     null $S0
  93     null $S1
  94     null $S2
  95     null $S3
  96     null $S4
  97     null $S5
  98     null $S7
  99     null $S8
 100     null $S9
 101
 102     init = stringinfo $S6, .STRINGINFO_STRSTART
 103
 104     $I0 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
 105   loop1:
 106     collect
 107     $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
 108     eq $I0, $I1, loop1
 109
 110     before = stringinfo $S6, .STRINGINFO_STRSTART
 111     unpin $S6
 112
 113     $I0 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
 114   loop2:
 115     collect
 116     $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
 117     eq $I0, $I1, loop1
 118
 119     after = stringinfo $S6, .STRINGINFO_STRSTART
 120
 121     is( init, before, "pin/collect didn't change memory address" )
 122     $I0 = cmp after, before
 123     print "# init: "
 124     $S0 = init
 125     print init
 126     print ", before: "
 127     $S0 = before
 128     print before
 129     print ", after: "
 130     $S0 = after
 131     print after
 132     print ", cmp: "
 133     $S0 = $I0
 134     say $S0
 135     ok( $I0, "location of string changed by unpin/collect" )
 136 .end
 137
 138 #.constant STRINGINFO_STRSTART  2
 139 #.constant STRINGINFO_BUFLEN    3
 140 #.constant STRINGINFO_FLAGS     4
 141 #.constant STRINGINFO_BUFUSED   5
 142 #.constant STRINGINFO_STRLEN    6
 143
 144 # Local Variables:
 145 #   mode: pir
 146 #   fill-column: 100
 147 # End:
 148 # vim: expandtab shiftwidth=4 ft=pir: