t/stm/basic_mt.t

   1 #! perl
   2 # Copyright (C) 2006-2007, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test;
  10 use Parrot::Config;
  11
  12 plan $^O =~ /MSWin32/
  13     ? ( skip_all => 'broken on Win32' )
  14     : tests => 4;
  15
  16 =head1 NAME
  17
  18 t/stm/basic_mt.t -- Multithreaded tests of STM ops and PMCs.
  19
  20 =head1 SYNOPSIS
  21
  22     % prove t/stm/basic_mt.t
  23
  24 =head1 DESCRIPTION
  25
  26 This file contains tests of the STM opcodes that require running
  27 multiple threads at once.
  28
  29 =cut
  30
  31 pir_output_is( <<'CODE', <<'OUTPUT', "wait (simple)" );
  32 .const int N = 1000
  33 .sub waiter
  34     .param pmc a
  35
  36 tx:
  37     stm_start
  38     if a < N goto retry
  39     a = -1
  40     stm_commit tx
  41     print "okay\n"
  42     .return ()
  43 retry:
  44     stm_wait invalid
  45     goto tx
  46 invalid:
  47     print "invalid (not okay)\n"
  48 .end
  49
  50 .sub incr
  51     .param pmc a
  52     .local int i
  53
  54     i = 0
  55 loop:
  56     stm_start
  57     inc a
  58     stm_commit loop
  59     inc i
  60     if i < N goto loop
  61 .end
  62
  63 .sub main :main
  64     .local pmc _incr
  65     .local pmc _waiter
  66
  67     .local pmc iThr
  68     .local pmc wThr
  69
  70     .local pmc a
  71
  72     a = new 'Integer'
  73     a = 0
  74     a = new 'STMRef', a
  75
  76     _incr = global "incr"
  77     _waiter = global "waiter"
  78
  79     wThr = new 'ParrotThread'
  80     wThr.'run_clone'(_waiter, a)
  81
  82     sleep 1 # let it really wait
  83     iThr = new 'ParrotThread'
  84     iThr.'run_clone'(_incr, a)
  85
  86     wThr.'join'()
  87     iThr.'join'()
  88 .end
  89 CODE
  90 okay
  91 OUTPUT
  92
  93 SKIP: {
  94     skip( "Intermittent failures on all platforms", 2 );
  95
  96 pir_output_is( <<'CODE', <<'OUTPUT', "wait (simple, strings)" );
  97 .const int N = 1000
  98 .sub waiter
  99     .param pmc a
 100
 101 tx:
 102     stm_start
 103     $I0 = elements a
 104     if $I0 < N goto retry
 105     a = "done"
 106     stm_commit tx
 107     print "okay\n"
 108     .return ()
 109 retry:
 110     stm_wait invalid
 111     goto tx
 112 invalid:
 113     print "invalid (not okay)\n"
 114 .end
 115
 116 .sub incr
 117     .param pmc a
 118     .local int i
 119
 120     i = 0
 121 loop:
 122     stm_start
 123     concat a, a, "x"
 124     stm_commit loop
 125     inc i
 126     if i < N goto loop
 127 .end
 128
 129 .sub main :main
 130     .local pmc _incr
 131     .local pmc _waiter
 132
 133     .local pmc iThr
 134     .local pmc wThr
 135
 136     .local pmc a
 137
 138     a = new 'String'
 139     a = ""
 140     a = new 'STMRef', a
 141
 142     _incr = global "incr"
 143     _waiter = global "waiter"
 144
 145     wThr = new 'ParrotThread'
 146     wThr.'run_clone'(_waiter, a)
 147
 148     sleep 1 # let it really wait
 149     iThr = new 'ParrotThread'
 150     iThr.'run_clone'(_incr, a)
 151
 152     iThr.'join'()
 153     wThr.'join'()
 154 .end
 155 CODE
 156 okay
 157 OUTPUT
 158
 159 # This test is designed to trigger the internal deadlock detection.
 160 # Occassionally both thread 1 and thread 2 should grab
 161 # main's 'a' and main's 'b', respectively, and then try to acquire
 162 # the other. Because of deadlock detection, exactly one of the two
 163 # threads should quickly be aborted and the other should succeed.
 164 # Without deadlock detection, the test will not complete quickly.
 165
 166     pir_output_like( <<'CODE', <<'OUTPUT', "get deadlock" );
 167 .const int N = 10000
 168 .sub thread_task
 169     .param pmc a
 170     .param pmc b
 171     .local int i
 172
 173     i = 0
 174
 175 loop:
 176     stm_start
 177     a = i
 178     b = i
 179     stm_commit loop
 180     # print "loop iteration "
 181     # print i
 182     # print "\n"
 183     inc i
 184     if i < N goto loop
 185 .end
 186
 187 .sub main :main
 188     .local pmc a
 189     .local pmc b
 190     .local pmc _task
 191     .local pmc t1
 192     .local pmc t2
 193
 194     a = new 'Integer'
 195     a = new 'STMRef', a
 196     b = new 'Integer'
 197     b = new 'STMRef', b
 198
 199     _task = global "thread_task"
 200
 201     t1 = new 'ParrotThread'
 202     t2 = new 'ParrotThread'
 203     t1.'run_clone'(_task, a, b)
 204     t2.'run_clone'(_task, b, a)
 205
 206     t1.'join'()
 207     t2.'join'()
 208
 209     print "okay\n"
 210 .end
 211 CODE
 212 /okay/
 213 OUTPUT
 214
 215 }    #skip x86_64
 216
 217 pir_output_is( <<'CODE', <<'OUTPUT', "wait + invalidate outer transcation" );
 218 .const int N = 50
 219 .sub waiter
 220     .param pmc a
 221
 222 tx:
 223     stm_start
 224     if a < N goto retry
 225     a = -1
 226     stm_commit tx
 227     print "okay\n"
 228     .return ()
 229 retry:
 230     # we start a nested transcation here;
 231     # the only we we ill get out of this loop
 232     # is if stm_wait jumps to 'invalid'.
 233     stm_start
 234     stm_wait invalid
 235     goto retry
 236 invalid:
 237     stm_abort
 238     goto tx
 239 .end
 240
 241 .sub incr
 242     .param pmc a
 243     .local int i
 244
 245     i = 0
 246 loop:
 247     stm_start
 248     inc a
 249     stm_commit loop
 250     inc i
 251     if i < N goto loop
 252 .end
 253
 254 .sub main :main
 255     .local pmc _incr
 256     .local pmc _waiter
 257
 258     .local pmc iThr
 259     .local pmc wThr
 260
 261     .local pmc a
 262
 263     a = new 'Integer'
 264     a = 0
 265     a = new 'STMRef', a
 266
 267     _incr = global "incr"
 268     _waiter = global "waiter"
 269
 270     wThr = new 'ParrotThread'
 271     wThr.'run_clone'(_waiter, a)
 272
 273     sleep 1 # let it really wait
 274     iThr = new 'ParrotThread'
 275     iThr.'run_clone'(_incr, a)
 276
 277     wThr.'join'()
 278     iThr.'join'()
 279 .end
 280 CODE
 281 okay
 282 OUTPUT
 283
 284 # Local Variables:
 285 #   mode: cperl
 286 #   cperl-indent-level: 4
 287 #   fill-column: 100
 288 # End:
 289 # vim: expandtab shiftwidth=4: