t/pmc/threads.t

   1 #! perl
   2 # Copyright (C) 2001-2009, Parrot 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 =head1 NAME
  13
  14 t/pmc/threads.t - Threads
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/pmc/threads.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests running threads. All tests skipped unless running on known-good
  23 platform.
  24
  25 =cut
  26
  27 if ( $^O eq "cygwin" ) {
  28     my @uname = split / /, qx'uname -v';
  29
  30     if ( $uname[0] eq "2004-09-04" ) {
  31         plan skip_all => "This cygwin version is known to fail the thread tests";
  32         exit;
  33     }
  34 }
  35 if ( $PConfig{HAS_THREADS} ) {
  36     plan tests => 14;
  37 }
  38 else {
  39     plan skip_all => "No threading enabled for '$^O'";
  40 }
  41
  42 pasm_output_is( <<'CODE', <<'OUTPUT', "interp identity" );
  43     getinterp P2
  44     clone P3, P2
  45     ne P3, P2, ok1
  46     print "not"
  47 ok1:
  48     print "ok 1\n"
  49     new P4, ['ParrotThread']
  50     ne P2, P4, ok2
  51     print "not"
  52 ok2:
  53     print "ok 2\n"
  54     end
  55 CODE
  56 ok 1
  57 ok 2
  58 OUTPUT
  59
  60 SKIP: {
  61     skip 'busted on win32' => 2 if $^O eq 'MSWin32';
  62
  63     pir_output_is( <<'CODE', <<'OUTPUT', "thread type 1" );
  64 .sub main :main
  65     .local pmc threadfunc
  66     .local pmc thread
  67     $I5 = 10
  68     threadfunc = get_global "foo"
  69     thread = new ['ParrotThread']
  70     thread.'run_clone'(threadfunc)
  71
  72     sleep 1
  73     print "main "
  74     print $I5
  75     print "\n"
  76     # get tid of thread
  77     $I0 = thread
  78     # wait for it
  79     thread.'join'()
  80 .end
  81
  82 .sub foo
  83     # check if vars are fresh
  84     inc $I5
  85     print "thread"
  86     # print I5 # not done because registers aren't guaranteed to be
  87                # initialized to anything in particular
  88     print "\n"
  89     set $I3, 0   # no retval
  90     returncc    # ret and be done with thread
  91 .end
  92 # output from threads could be reversed
  93 CODE
  94 thread
  95 main 10
  96 OUTPUT
  97
  98     pir_output_is( <<'CODE', <<'OUTPUT', "thread type 1 -- repeated" );
  99 .sub real_main :main
 100     $I0 = 0
 101 loop:
 102     main()
 103     inc $I0
 104     if $I0 < 2 goto loop
 105 .end
 106
 107 .sub main
 108     .local pmc threadfunc
 109     .local pmc thread
 110     $I5 = 10
 111     threadfunc = get_global "foo"
 112     thread = new ['ParrotThread']
 113     thread.'run_clone'(threadfunc)
 114
 115     sleep 1
 116     print "main "
 117     print $I5
 118     print "\n"
 119     # get tid of thread
 120     $I0 = thread
 121     # wait for it
 122     thread.'join'()
 123 .end
 124
 125 .sub foo
 126     # check if vars are fresh
 127     inc $I5
 128     print "thread"
 129     # print I5 # not done because registers aren't guaranteed to be
 130                # initialized to anything in particular
 131     print "\n"
 132     set $I3, 0   # no retval
 133     returncc    # ret and be done with thread
 134 .end
 135 # output from threads could be reversed
 136 CODE
 137 thread
 138 main 10
 139 thread
 140 main 10
 141 OUTPUT
 142 }
 143
 144
 145 pir_output_is( <<'CODE', <<'OUTPUT', "thread type 2" );
 146 .sub main :main
 147     set $I5, 10
 148     .local pmc thread
 149     .local pmc threadsub
 150     $S5 = " interp\n"
 151     $P6 = new ['String']
 152     $P6 = 'from '
 153
 154     print "ok 1\n"
 155     threadsub = get_global "foo"
 156     thread = new ['ParrotThread']
 157     thread.'run_clone'(threadsub, $P6)
 158     sleep 1 # to let the thread run
 159     print $P6
 160     print $I5
 161     print $S5
 162     thread.'join'()
 163 .end
 164
 165 .sub foo
 166     .param pmc passed
 167     inc $I5
 168     $S5 = " thread\n"
 169     .local pmc salutation
 170     salutation = box 'hello from'
 171     print salutation
 172     # print I5 # not done because register initialization is not guaranteed
 173     print $S5
 174     $P0 = getinterp
 175     $S0 = typeof $P0
 176     print $S0
 177     print ' tid '
 178     $I0 = $P0
 179     print $I0
 180     print "\n"
 181 .end
 182 CODE
 183 ok 1
 184 hello from thread
 185 ThreadInterpreter tid 1
 186 from 10 interp
 187 OUTPUT
 188
 189
 190 pir_output_is( <<'CODE', <<'OUTPUT', 'thread - kill' );
 191 .sub main :main
 192     .local pmc threadsub
 193     .local pmc thread
 194     bounds 1    # assert slow core -S and -g are fine too
 195     threadsub = get_global "foo"
 196     thread = new ['ParrotThread']
 197     $I0 = thread
 198     print 'start '
 199     print $I0
 200     print "\n"
 201     thread.'run_clone'(threadsub)
 202
 203     sleep 1 # to let the thread run
 204
 205     thread.'kill'()
 206
 207     print "done\n"
 208 .end
 209
 210 .sub foo
 211     print "in thread\n"
 212     # run an endles loop
 213 lp:
 214     noop
 215     branch lp
 216 .end
 217 CODE
 218 start -1
 219 in thread
 220 done
 221 OUTPUT
 222
 223
 224 pir_output_is( <<'CODE', <<'OUTPUT', "join, get retval" );
 225 .sub _main
 226     .const int MAX = 1000
 227     .local pmc kid
 228     .local pmc Adder
 229     Adder = get_global '_add'
 230     kid = new ['ParrotThread']
 231     .local pmc from
 232     from = new ['Integer']
 233     from = 0
 234     .local pmc to
 235     to = new ['Integer']
 236     to = MAX
 237     kid.'run_clone'(Adder, Adder, from, to)
 238
 239     .local pmc result
 240     result = kid.'join'()
 241     print result
 242     print "\n"
 243     # sum = n * (n + 1)/2
 244     .local pmc Mul
 245     Mul = new ['Integer']
 246     assign Mul, to
 247     inc Mul
 248     Mul = to * Mul
 249     Mul = Mul / 2
 250     print Mul
 251     print "\n"
 252     end
 253 .end
 254
 255 .sub _add
 256    .param pmc sub
 257    .param pmc from
 258    .param pmc to
 259    .local pmc sum
 260    sum = new ['Integer']
 261 loop:
 262     add sum, from
 263     inc from
 264     le from, to, loop
 265
 266     .begin_return
 267     .set_return sum
 268     .end_return
 269 .end
 270 CODE
 271 500500
 272 500500
 273 OUTPUT
 274
 275 pir_output_is( <<'CODE', <<'OUT', "sub name lookup in new thread" );
 276 .sub check
 277     $P0 = get_global ['Foo'], 'foo'
 278     $I0 = isa $P0, 'Sub'
 279     if $I0 goto okay
 280     print "not "
 281 okay:
 282     print "ok\n"
 283 .end
 284
 285 .sub main :main
 286     check()
 287     $P0 = new ['ParrotThread']
 288     .local pmc thread_main
 289     thread_main = get_global 'thread_main'
 290     $P0.'run_clone'(thread_main)
 291     $P0.'join'()
 292 .end
 293
 294 .sub thread_main
 295     check()
 296 .end
 297
 298 .namespace [ 'Foo' ]
 299
 300 .sub foo
 301     print "not reached\n"
 302 .end
 303 CODE
 304 ok
 305 ok
 306 OUT
 307
 308 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE only" );
 309
 310 .namespace [ 'Test2' ]
 311 .sub test2
 312     print "ok 2\n"
 313 .end
 314
 315 .namespace [ 'Test3' ]
 316 .sub test3
 317     print "ok 3\n"
 318 .end
 319
 320 .namespace [ 'main' ]
 321
 322 .include 'errors.pasm'
 323 .sub thread_func
 324     .param pmc test2
 325     print "ok 1\n"
 326     test2()
 327     .local pmc test3
 328     test3 = get_hll_global ['Test3'], 'test3'
 329     test3()
 330     .local pmc test4
 331     errorsoff .PARROT_ERRORS_GLOBALS_FLAG
 332     test4 = get_global 'test4'
 333     if null test4 goto okay
 334     print "not "
 335 okay:
 336     print "ok 4\n"
 337 .end
 338
 339 .include 'cloneflags.pasm'
 340 .sub main :main
 341     .local pmc test4
 342     .local pmc test2
 343
 344     test2 = get_hll_global ['Test2'], 'test2'
 345
 346     test4 = new ['Integer']
 347     test4 = 42
 348     set_global 'test4', test4
 349
 350     .local pmc thread
 351     thread = new ['ParrotThread']
 352     .local pmc thread_func
 353     thread_func = get_global 'thread_func'
 354     $I0 = .PARROT_CLONE_CODE
 355     thread.'run'($I0, thread_func, test2)
 356     thread.'join'()
 357     print "ok 5\n"
 358 .end
 359 CODE
 360 ok 1
 361 ok 2
 362 ok 3
 363 ok 4
 364 ok 5
 365 OUTPUT
 366
 367 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_GLOBALS" );
 368
 369 .namespace [ 'Foo' ]
 370 .sub 'is'
 371     .param pmc what
 372     .param pmc expect
 373     .param pmc label
 374     .param pmc shortlabel
 375     if what == expect goto okay
 376     print "# "
 377     print label
 378     print "\n"
 379     print "# got:      "
 380     print what
 381     print "\n"
 382     print "# expected: "
 383     print expect
 384     print "\nnot "
 385 okay:
 386     print "ok "
 387     print shortlabel
 388     print "\n"
 389 .end
 390
 391 .sub thread_test_func
 392     $P0 = get_hll_global [ 'Bar' ], 'alpha'
 393     'is'($P0, 1, 'Bar::alpha == 1', 'alpha')
 394     $P0 = 43
 395     sleep 0.2 # give enough time that the main thread might modify
 396               # any shared Foo::beta can cause phantom errors
 397     $P0 = get_global 'beta'
 398     'is'($P0, 2, 'Foo::beta == 2 [accessed locally]', 'beta1')
 399     $P0 = 5
 400     $P0 = get_global 'beta'
 401     'is'($P0, 5, 'Foo::beta == 5 [accessed locally after assignment]', 'beta2')
 402     $P0 = get_hll_global [ 'Foo' ], 'beta'
 403     'is'($P0, 5, 'Foo::beta == 5 [after assign; absolute]', 'beta3')
 404 .end
 405
 406 .namespace [ 'main' ]
 407
 408 .sub test_setup
 409     $P0 = new ['Integer']
 410     $P0 = 1
 411     set_hll_global [ 'Bar' ], 'alpha', $P0
 412     $P0 = new ['Integer']
 413     $P0 = 2
 414     set_hll_global [ 'Foo' ], 'beta', $P0
 415 .end
 416
 417 .include 'cloneflags.pasm'
 418 .sub main :main
 419     'test_setup'()
 420
 421     .local pmc thread
 422     thread = new ['ParrotThread']
 423     .local pmc _thread_func
 424     _thread_func = get_hll_global [ 'Foo' ], 'thread_test_func'
 425     $I0 = .PARROT_CLONE_CODE
 426     bor $I0, $I0, .PARROT_CLONE_GLOBALS
 427     print "in thread:\n"
 428     thread.'run'($I0, _thread_func)
 429     $P0 = get_hll_global [ 'Foo' ], 'beta'
 430     $P0 = 42
 431     thread.'join'()
 432     print "in main:\n"
 433     $P0 = 2
 434     _thread_func()
 435 .end
 436 CODE
 437 in thread:
 438 ok alpha
 439 ok beta1
 440 ok beta2
 441 ok beta3
 442 in main:
 443 ok alpha
 444 ok beta1
 445 ok beta2
 446 ok beta3
 447 OUTPUT
 448
 449 TODO: {
 450     local $TODO = "vtable overrides aren't properly cloned TT # 1248";
 451
 452     pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_CLASSES; superclass not built-in" );
 453 .namespace [ 'Foo' ]
 454
 455 .sub foometh :method
 456     print "called Foo's foometh\n"
 457 .end
 458
 459 .sub barmeth :method
 460     print "called Foo's barmeth\n"
 461 .end
 462
 463 .namespace [ 'Bar' ]
 464
 465 .sub barmeth :method
 466     print "called Bar's barmeth\n"
 467 .end
 468
 469 .sub get_string :vtable :method
 470     .return ("A Bar")
 471 .end
 472
 473 .namespace [ 'main' ]
 474
 475 .sub init
 476     $P1 = newclass 'Foo'
 477     addattribute $P1, 'foo1'
 478     addattribute $P1, 'foo2'
 479     $P2 = subclass $P1, 'Bar'
 480     addattribute $P2, 'bar1'
 481 .end
 482
 483 .sub thread_test_func
 484     $P0 = new ['Bar']
 485     print $P0
 486     print "\n"
 487     $P0.'barmeth'()
 488     $P0.'foometh'()
 489     $I0 = isa $P0, 'Integer'
 490     print "Integer? "
 491     print $I0
 492     print "\n"
 493     $I0 = isa $P0, 'Foo'
 494     print "Foo? "
 495     print $I0
 496     print "\n"
 497     $I0 = isa $P0, 'Bar'
 498     print "Bar? "
 499     print $I0
 500     print "\n"
 501 .end
 502
 503 .include 'cloneflags.pasm'
 504 .sub main :main
 505     init()
 506
 507     .local pmc thread
 508     thread = new ['ParrotThread']
 509     .local pmc _thread_func
 510     _thread_func = get_hll_global ['main'], 'thread_test_func'
 511     $I0 = .PARROT_CLONE_CODE
 512     bor $I0, $I0, .PARROT_CLONE_CLASSES
 513     print "in thread:\n"
 514     thread.'run'($I0, _thread_func)
 515     thread.'join'()
 516     print "in main:\n"
 517     _thread_func()
 518 .end
 519 CODE
 520 in thread:
 521 A Bar
 522 called Bar's barmeth
 523 called Foo's foometh
 524 Integer? 0
 525 Foo? 1
 526 Bar? 1
 527 in main:
 528 A Bar
 529 called Bar's barmeth
 530 called Foo's foometh
 531 Integer? 0
 532 Foo? 1
 533 Bar? 1
 534 OUTPUT
 535 }
 536
 537 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_CLASSES; superclass built-in", todo => 'likely incorrect test TT 1248');
 538 .namespace [ 'Foo' ]
 539
 540 .sub foometh :method
 541     print "called Foo's foometh\n"
 542 .end
 543
 544 .sub barmeth :method
 545     print "called Foo's barmeth\n"
 546 .end
 547
 548 .namespace [ 'Bar' ]
 549
 550 .sub barmeth :method
 551     print "called Bar's barmeth\n"
 552 .end
 553
 554 .sub get_string :vtable :method
 555     .return ("A Bar")
 556 .end
 557
 558 .namespace [ 'main' ]
 559
 560 .sub init
 561     $P0 = get_class 'Integer'
 562     $P1 = subclass $P0, 'Foo'
 563     addattribute $P1, 'foo1'
 564     addattribute $P1, 'foo2'
 565     $P2 = subclass $P1, 'Bar'
 566     addattribute $P2, 'bar1'
 567 .end
 568
 569 .sub thread_test_func
 570     $P0 = new ['Bar']
 571     print $P0
 572     print "\n"
 573     $P0.'barmeth'()
 574     $P0.'foometh'()
 575     $I0 = isa $P0, 'Integer'
 576     print "Integer? "
 577     print $I0
 578     print "\n"
 579     $I0 = isa $P0, 'Foo'
 580     print "Foo? "
 581     print $I0
 582     print "\n"
 583     $I0 = isa $P0, 'Bar'
 584     print "Bar? "
 585     print $I0
 586     print "\n"
 587 .end
 588
 589 .include 'cloneflags.pasm'
 590 .sub main :main
 591     init()
 592
 593     .local pmc thread
 594     thread = new ['ParrotThread']
 595     .local pmc _thread_func
 596     _thread_func = get_global 'thread_test_func'
 597     $I0 = .PARROT_CLONE_CODE
 598     bor $I0, $I0, .PARROT_CLONE_CLASSES
 599     print "in thread:\n"
 600     thread.'run'($I0, _thread_func)
 601     thread.'join'()
 602     print "in main:\n"
 603     _thread_func()
 604 .end
 605 CODE
 606 in thread:
 607 A Bar
 608 called Bar's barmeth
 609 called Foo's foometh
 610 Integer? 1
 611 Foo? 1
 612 Bar? 1
 613 in main:
 614 A Bar
 615 called Bar's barmeth
 616 called Foo's foometh
 617 Integer? 1
 618 Foo? 1
 619 Bar? 1
 620 OUTPUT
 621
 622 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_GLOBALS| CLONE_HLL" );
 623 .HLL 'Test'
 624 .sub setup
 625     $P0 = new ['Integer']
 626     $P0 = 42
 627     set_global 'x', $P0
 628 .end
 629
 630 .include 'interpinfo.pasm'
 631 .sub test
 632     $P0 = get_global 'x'
 633     if $P0 == 42 goto okay1
 634     print "not "
 635 okay1:
 636     print "ok 1\n"
 637     $P1 = get_root_namespace
 638     $P1 = $P1['test']
 639     $P1 = $P1['x']
 640     $P1 = 43
 641     if $P0 == 43 goto okay2
 642     print "not "
 643 okay2:
 644     print "ok 2\n"
 645 .end
 646
 647 .HLL ''
 648
 649 .include 'cloneflags.pasm'
 650
 651 .sub main :main
 652     .local pmc setup
 653     .local pmc test
 654     setup = get_root_namespace
 655     setup = setup['test']
 656     test = setup['test']
 657     setup = setup['setup']
 658     setup()
 659
 660     .local pmc thread
 661     .local int flags
 662     thread = new ['ParrotThread']
 663     flags = .PARROT_CLONE_CODE
 664     bor flags, flags, .PARROT_CLONE_GLOBALS
 665     bor flags, flags, .PARROT_CLONE_HLL
 666     print "in thread:\n"
 667     thread.'run'(flags, test)
 668     thread.'join'()
 669     print "in main:\n"
 670     test()
 671 .end
 672 CODE
 673 in thread:
 674 ok 1
 675 ok 2
 676 in main:
 677 ok 1
 678 ok 2
 679 OUTPUT
 680
 681 # Direct constant access to sub objects commented out, see TT #1120.
 682 pir_output_unlike( <<'CODE', qr/not/, "globals + constant table subs issue");
 683 .namespace [ 'Foo' ]
 684
 685 .include 'interpinfo.pasm'
 686 .sub 'is'
 687     .param pmc    what
 688     .param pmc    expect
 689     .param string desc      :optional
 690     .param int    have_desc :opt_flag
 691
 692     unless have_desc goto diagnose
 693     desc = ' - ' . desc
 694
 695   diagnose:
 696     .local pmc number
 697     number = get_global 'test_num'
 698     if what == expect goto okay
 699     print "# got:      "
 700     say what
 701     print "# expected: "
 702     say expect
 703     print "not ok "
 704     print number
 705     say desc
 706     inc number
 707     $P0 = interpinfo .INTERPINFO_CURRENT_CONT
 708 loop:
 709     $I0 = defined $P0
 710     if $I0 == 0 goto done
 711     print "    "
 712     say $P0
 713     $P0 = $P0.'continuation'()
 714     branch loop
 715 done:
 716     .return ()
 717 okay:
 718     print "ok "
 719     print number
 720     inc number
 721     say desc
 722 .end
 723
 724 .sub setup
 725     $P0 = new ['Integer']
 726     $P0 = 1
 727     set_global 'foo', $P0
 728 .end
 729
 730 .sub _check_sanity
 731     .param string desc
 732     $P0 = get_global 'foo'
 733     $P1 = get_hll_global [ 'Foo' ], 'foo'
 734     is($P0, $P1, desc)
 735 .end
 736
 737 .sub mutate
 738     $P0 = new ['Integer']
 739     $P0 = 2
 740     set_global 'foo', $P0
 741 .end
 742
 743 .sub check_sanity
 744 #    _check_sanity( 'direct call' )
 745     $P0 = get_global '_check_sanity'
 746     $P0( 'call from get_global' )
 747     $P0 = get_hll_global [ 'Foo' ], '_check_sanity'
 748     $P0( 'call from get_hll_global' )
 749 .end
 750
 751 .sub _check_value
 752     .param int value
 753     $P0 = get_global 'foo'
 754     is($P0, value)
 755 .end
 756
 757 .sub check_value
 758     .param int value
 759 #    _check_value(value)
 760     $P0 = get_global '_check_value'
 761     $P0(value)
 762     $P0 = get_hll_global [ 'Foo' ], '_check_value'
 763     $P0(value)
 764 .end
 765
 766 .sub full_check
 767 #    .const 'Sub' c_setup = 'setup'
 768 #    .const 'Sub' c_sanity = 'check_sanity'
 769 #    .const 'Sub' c_mutate = 'mutate'
 770 #    .const 'Sub' c_value = 'check_value'
 771
 772     .local pmc c_setup
 773     c_setup = get_global  'setup'
 774     .local pmc c_sanity
 775     c_sanity = get_global 'check_sanity'
 776     .local pmc c_mutate
 777     c_mutate = get_global 'mutate'
 778     .local pmc c_value
 779     c_value = get_global  'check_value'
 780
 781     .local pmc g_setup
 782     g_setup = get_hll_global [ 'Foo' ], 'setup'
 783     .local pmc g_sanity
 784     g_sanity = get_hll_global [ 'Foo' ], 'check_sanity'
 785     .local pmc g_mutate
 786     g_mutate = get_hll_global [ 'Foo' ], 'mutate'
 787     .local pmc g_value
 788     g_value = get_hll_global [  'Foo' ], 'check_value'
 789
 790     c_setup()
 791     c_sanity()
 792     g_sanity()
 793     c_value(1)
 794     g_value(1)
 795     c_mutate()
 796     c_value(2)
 797     g_value(2)
 798     c_sanity()
 799     g_sanity()
 800
 801     g_setup()
 802     c_sanity()
 803     g_sanity()
 804     c_value(1)
 805     g_value(1)
 806     g_mutate()
 807     c_value(2)
 808     g_value(2)
 809     c_sanity()
 810     g_sanity()
 811 .end
 812
 813
 814
 815 .sub main :main
 816     $P0 = new ['Integer']
 817     $P0 = 1
 818     set_global 'test_num', $P0
 819
 820     .const 'Sub' _check = 'full_check'
 821     _check()
 822
 823     $P0 = new ['ParrotThread']
 824     $P0.'run_clone'(_check)
 825     $P0.'join'()
 826 .end
 827 CODE
 828
 829 pir_output_is(
 830     <<'CODE', <<'OUTPUT', 'CLONE_CODE|CLONE_GLOBALS|CLONE_HLL|CLONE_LIBRARIES - TT # 1250' );
 831 .HLL 'Perl'
 832
 833 .include 'interpinfo.pasm'
 834
 835 .loadlib 'foo_group'
 836
 837 .sub test
 838     .param pmc passed_value
 839     .local pmc the_value
 840     the_value = new ['Integer']
 841     the_value = 42
 842     set_hll_global ['Foo'], 'x', the_value
 843     $S0 = typeof passed_value
 844     $S1 = typeof the_value
 845     $I0 = iseq $S0, $S1
 846     say $I0
 847
 848     .local pmc ns
 849     ns = get_namespace ['Foo']
 850     $P0 = interpinfo .INTERPINFO_CURRENT_SUB
 851     ns = $P0.'get_namespace'()
 852     ns = ns['Foo']
 853     $P0 = ns['x']
 854     if $P0 == the_value goto okay
 855     print "not "
 856 okay:
 857     say "ok (equal)"
 858
 859     $I0 = the_value
 860     say $I0
 861 .end
 862
 863 .include 'cloneflags.pasm'
 864
 865 .sub main :main
 866     .local pmc thread
 867     .local int flags
 868     thread = new ['ParrotThread']
 869     flags = .PARROT_CLONE_CODE
 870     bor flags, flags, .PARROT_CLONE_GLOBALS
 871     bor flags, flags, .PARROT_CLONE_HLL
 872     bor flags, flags, .PARROT_CLONE_LIBRARIES
 873
 874     .local pmc passed
 875     passed = new ['Foo']
 876     passed = 15
 877
 878     .local pmc thread_func
 879     thread_func = get_global 'test'
 880     say "in thread:"
 881     thread.'run'(flags, thread_func, passed)
 882     thread.'join'()
 883     say "in main:"
 884     thread_func(passed)
 885 .end
 886 CODE
 887 in thread:
 888 0
 889 ok (equal)
 890 42
 891 in main:
 892 0
 893 ok (equal)
 894 42
 895 OUTPUT
 896
 897 # Local Variables:
 898 #   mode: cperl
 899 #   cperl-indent-level: 4
 900 #   fill-column: 100
 901 # End:
 902 # vim: expandtab shiftwidth=4: