t/pmc/threads.t

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