* src/pmc/scalar.pmc:
[parrot.git] / t / pmc / threads.t
blob2be31b33856e0d9510a8e15b1d660e132c8573bb
1 #! perl
2 # Copyright (C) 2001-2005, The Perl Foundation.
3 # $Id$
5 use strict;
6 use warnings;
7 use lib qw( . lib ../lib ../../lib );
8 use Test::More;
9 use Parrot::Test;
11 =head1 NAME
13 t/pmc/threads.t - Threads
15 =head1 SYNOPSIS
17     % prove t/pmc/threads.t
19 =head1 DESCRIPTION
21 Tests running threads. All tests skipped unless running on known-good
22 platform.
24 =cut
26 my %platforms = map { $_ => 1 } qw/
27     aix
28     cygwin
29     dec_osf
30     freebsd
31     hpux
32     irix
33     linux
34     openbsd
35     solaris
36     MSWin32
37     /;
39 if ( $^O eq "cygwin" ) {
40     my @uname = split / /, qx'uname -v';
42     if ( $uname[0] eq "2004-09-04" ) {
43         plan skip_all => "This cygwin version is known to fail the thread tests";
44         exit;
45     }
47 if ( $platforms{$^O} ) {
48     plan tests => 20;
50 else {
51     plan skip_all => "No threading yet or test not enabled for '$^O'";
53     # plan skip_all => "Needs COPY for argument passing";
56 pasm_output_is( <<'CODE', <<'OUTPUT', "interp identity" );
57     getinterp P2
58     clone P3, P2
59     ne P3, P2, ok1
60     print "not"
61 ok1:
62     print "ok 1\n"
63     new P4, .ParrotThread
64     ne P4, P2, ok2
65     print "not"
66 ok2:
67     print "ok 2\n"
68     end
69 CODE
70 ok 1
71 ok 2
72 OUTPUT
74 # XXX FIXME rework tests since we don't really have thread types?
76 SKIP: {
77     skip 'busted on win32' => 2 if $^O eq 'MSWin32';
79     pir_output_is( <<'CODE', <<'OUTPUT', "thread type 1" );
80 .sub main :main
81     .local pmc threadfunc
82     .local pmc thread
83     I5 = 10
84     threadfunc = global "foo"
85     thread = new .ParrotThread
86     thread.'run_clone'(threadfunc)
88     sleep 1
89     print "main "
90     print I5
91     print "\n"
92     # get tid of thread
93     $I0 = thread 
94     # wait for it
95     thread.'join'()
96 .end
98 .sub foo 
99     # check if vars are fresh
100     inc I5
101     print "thread"
102     # print I5 # not done because registers aren't guaranteed to be
103                # initialized to anything in particular
104     print "\n"
105     set I3, 0   # no retval
106     returncc    # ret and be done with thread
107 .end
108 # output from threads could be reversed
109 CODE
110 thread
111 main 10
112 OUTPUT
114     pir_output_is( <<'CODE', <<'OUTPUT', "thread type 1 -- repeated" );
115 .sub real_main :main
116     $I0 = 0
117 loop:
118     main()
119     inc $I0
120     if $I0 < 2 goto loop
121 .end
123 .sub main
124     .local pmc threadfunc
125     .local pmc thread
126     I5 = 10
127     threadfunc = global "foo"
128     thread = new .ParrotThread
129     thread.'run_clone'(threadfunc)
131     sleep 1
132     print "main "
133     print I5
134     print "\n"
135     # get tid of thread
136     $I0 = thread 
137     # wait for it
138     thread.'join'()
139 .end
141 .sub foo 
142     # check if vars are fresh
143     inc I5
144     print "thread"
145     # print I5 # not done because registers aren't guaranteed to be
146                # initialized to anything in particular
147     print "\n"
148     set I3, 0   # no retval
149     returncc    # ret and be done with thread
150 .end
151 # output from threads could be reversed
152 CODE
153 thread
154 main 10
155 thread
156 main 10
157 OUTPUT
160 pir_output_is( <<'CODE', <<'OUTPUT', "thread type 2" );
161 .sub main :main
162     set I5, 10
163     .local pmc thread
164     .local pmc threadsub
165     S5 = " interp\n"
166     P6 = new .String
167     P6 = 'from '
169     print "ok 1\n"
170     threadsub = global "foo"
171     thread = new .ParrotThread
172     thread.'run_clone'(threadsub, P6)
173     sleep 1 # to let the thread run
174     print P6
175     print I5
176     print S5
177     thread.'join'()
178 .end
180 .sub foo
181     .param pmc passed
182     inc I5
183     S5 = " thread\n"
184     passed = 'hello from'
185     print passed
186     # print I5 # not done because register initialization is not guaranteed
187     print S5
188     $P0 = getinterp
189     $S0 = typeof $P0
190     print $S0
191     print ' tid '
192     $I0 = $P0
193     print $I0
194     print "\n"
195 .end
196 CODE
197 ok 1
198 hello from thread
199 ParrotThread tid 1
200 from 10 interp
201 OUTPUT
203 pir_output_is( <<'CODE', <<'OUTPUT', 'thread - kill' );
204 .sub main :main
205     .local pmc threadsub
206     .local pmc thread
207     bounds 1    # assert slow core -S and -g are fine too
208     threadsub = global "foo"
209     thread = new .ParrotThread
210     $I0 = thread
211     print 'start '
212     print $I0
213     print "\n"
214     thread.'run_clone'(threadsub)
216     sleep 1 # to let the thread run
218     thread.'kill'()
220     print "done\n"
221 .end
223 .sub foo
224     print "in thread\n"
225     # run an endles loop
227     noop
228     branch lp
229 .end
230 CODE
231 start 1
232 in thread
233 done
234 OUTPUT
236 pir_output_is( <<'CODE', <<'OUTPUT', "join, get retval" );
237 .sub _main
238     .const int MAX = 1000
239     .sym pmc kid
240     .sym pmc Adder
241     Adder = global '_add'
242     kid = new ParrotThread
243     .sym pmc from
244     from = new Integer
245     from = 0
246     .sym pmc to
247     to = new Integer
248     to = MAX
249     kid.'run_clone'(Adder, Adder, from, to)
251     .local pmc result
252     result = kid.'join'()
253     print result
254     print "\n"
255     # sum = n * (n + 1)/2
256     .sym pmc Mul
257     Mul = new Integer
258     assign Mul, to
259     inc Mul
260     Mul = to * Mul
261     Mul = Mul / 2
262     print Mul
263     print "\n"
264     end
265 .end
267 .sub _add
268    .param pmc sub
269    .param pmc from
270    .param pmc to
271    .sym   pmc sum
272    sum = new Integer
273 loop:
274     add sum, from
275     inc from
276     le from, to, loop
278     .pcc_begin_return
279     .return sum
280     .pcc_end_return
281 .end
282 CODE
283 500500
284 500500
285 OUTPUT
287 SKIP: {
288     skip( "detatch broken on $^O", 1 ) if ( $^O =~ /MSWin32/ );
289     pir_output_like( <<'CODE', <<'OUTPUT', "detach" );
290 .sub main :main
291     .local pmc foo
292     .local pmc queue
293     .local pmc thread
294     foo = global '_foo'
295     queue = new .TQueue # flag for when the thread is done
296     thread = new .ParrotThread
297     thread.'run_clone'(foo, queue)
298     
299     thread.'detach'()
300 wait:
301     defined $I0, queue
302     if $I0 == 0 goto wait
303     print "done\n"
304 .end
306 .sub _foo
307     .param pmc queue
308     print "thread\n"
309     sleep 0.1
310     $P1 = new .Integer
311     push queue, $P1
312 .end
313 CODE
314 /(done\nthread\n)|(thread\ndone\n)/
315 OUTPUT
318 pir_output_is( <<'CODE', <<'OUTPUT', "share a PMC" );
319 .sub main :main
320     .local pmc foo
321     foo = global "_foo"
322     .local pmc to_share
323     to_share = new Integer
324     .local pmc shared_ref
325     shared_ref = new SharedRef, to_share
326     shared_ref = 20
327     .local pmc thread
328     thread = new ParrotThread
329     thread.'run_clone'(foo, shared_ref)
331     sleep 0.1 # to let the thread run
332     
333     .local pmc result
334     thread.'join'()
335     print "done\n"
336     print shared_ref
337     print "\n"
338 .end
340 .sub _foo
341     .param pmc shared_ref
342     print "thread\n"
343     print shared_ref
344     print "\n"
345     inc shared_ref
346 .end
347 CODE
348 thread
350 done
352 OUTPUT
354 pir_output_is( <<'CODE', <<'OUT', "multi-threaded" );
355 .sub main :main
356     .local pmc queue
357     queue = new TQueue
358     .local pmc tmpInt
359     tmpInt = new Integer
360     tmpInt = 1
361     push queue, tmpInt
362     tmpInt = new Integer
363     tmpInt = 2
364     push queue, tmpInt
365     tmpInt = new Integer
366     tmpInt = 3
367     push queue, tmpInt
368     
369     .local pmc thread
370     thread = new ParrotThread
371     .local pmc foo
372     foo = global '_foo'
373     thread.'run_clone'(foo, queue)
374     thread.'join'()
375     print "done main\n"
376 .end
378 .sub _foo
379     .param pmc queue
380     $I0 = queue
381     print $I0
382     print "\n"
383 loop:
384     $I0 = queue
385     if $I0 == 0 goto done 
386     shift $P0, queue
387     print $P0
388     print "\n"
389     branch loop
390 done:
391     print "done thread\n"
392 .end
393 CODE
398 done thread
399 done main
402 pir_output_is( <<'CODE', <<'OUT', "sub name lookup in new thread" );
403 .sub check
404     $P0 = find_global 'Foo', 'foo'
405     $I0 = isa $P0, 'Sub'
406     if $I0 goto okay
407     print "not "
408 okay:
409     print "ok\n"
410 .end
412 .sub main :main
413     check()
414     $P0 = new ParrotThread
415     .local pmc thread_main
416     thread_main = find_global 'thread_main'
417     $P0.'run_clone'(thread_main)
418     $P0.'join'() # XXX
419 .end
421 .sub thread_main
422     check()
423 .end
425 .namespace [ 'Foo' ]
427 .sub foo
428     print "not reached\n"
429 .end
430 CODE
435 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE only" );
437 .namespace [ 'Test2' ]
438 .sub test2
439     print "ok 2\n"
440 .end
442 .namespace [ 'Test3' ]
443 .sub test3
444     print "ok 3\n"
445 .end
447 .namespace [ 'main' ]
449 .include 'errors.pasm'
450 .sub thread_func
451     .param pmc test2
452     print "ok 1\n"
453     test2()
454     .local pmc test3
455     test3 = find_global 'Test3', 'test3'
456     test3()
457     .local pmc test4
458     errorsoff .PARROT_ERRORS_GLOBALS_FLAG
459     test4 = global 'test4'
460     if null test4 goto okay
461     print "not "
462 okay:
463     print "ok 4\n"
464 .end
466 .include 'cloneflags.pasm'
467 .sub main :main
468     .local pmc test4
469     .local pmc test2
471     test2 = find_global 'Test2', 'test2'
473     test4 = new Integer
474     test4 = 42
475     store_global 'test4', test4
477     .local pmc thread
478     thread = new ParrotThread
479     .local pmc thread_func
480     thread_func = global 'thread_func'
481     $I0 = .PARROT_CLONE_CODE 
482     thread.'run'($I0, thread_func, test2)
483     thread.'join'()
484     print "ok 5\n"
485 .end
486 CODE
487 ok 1
488 ok 2
489 ok 3
490 ok 4
491 ok 5
492 OUTPUT
494 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_GLOBALS" );
496 .namespace [ 'Foo' ]
497 .sub 'is'
498     .param pmc what
499     .param pmc expect
500     .param pmc label
501     .param pmc shortlabel
502     if what == expect goto okay
503     print "# "
504     print label
505     print "\n"
506     print "# got:      "
507     print what
508     print "\n"
509     print "# expected: "
510     print expect
511     print "\nnot "
512 okay:
513     print "ok "
514     print shortlabel
515     print "\n"
516 .end
518 .sub thread_test_func 
519     $P0 = find_global 'Bar', 'alpha'
520     'is'($P0, 1, 'Bar::alpha == 1', 'alpha')
521     $P0 = 43
522     sleep 0.1 # give enough time that the main thread might modify
523               # any shared Foo::beta dn cause phantom errors
524     $P0 = find_global 'beta'
525     'is'($P0, 2, 'Foo::beta == 2 [accessed locally]', 'beta1')
526     $P0 = 5
527     $P0 = find_global 'beta'
528     'is'($P0, 5, 'Foo::beta == 5 [accessed locally after assignment]', 'beta2')
529     $P0 = find_global 'Foo', 'beta'
530     'is'($P0, 5, 'Foo::beta == 5 [after assign; absolute]', 'beta3')
531 .end
533 .namespace [ 'main' ]
535 .sub test_setup 
536     $P0 = new Integer
537     $P0 = 1
538     store_global 'Bar', 'alpha', $P0
539     $P0 = new Integer
540     $P0 = 2
541     store_global 'Foo', 'beta', $P0
542 .end
544 .include 'cloneflags.pasm'
545 .sub main :main
546     'test_setup'()
548     .local pmc thread
549     thread = new ParrotThread
550     .local pmc _thread_func
551     _thread_func = find_global 'Foo', 'thread_test_func'
552     $I0 = .PARROT_CLONE_CODE
553     bor $I0, $I0, .PARROT_CLONE_GLOBALS
554     print "in thread:\n"
555     thread.'run'($I0, _thread_func)
556     $P0 = find_global 'Foo', 'beta'
557     $P0 = 42
558     thread.'join'()
559     print "in main:\n"
560     $P0 = 2
561     _thread_func()
562 .end
563 CODE
564 in thread:
565 ok alpha
566 ok beta1
567 ok beta2
568 ok beta3
569 in main:
570 ok alpha
571 ok beta1
572 ok beta2
573 ok beta3
574 OUTPUT
576 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_CLASSES; superclass not built-in" );
577 .namespace [ 'Foo' ]
579 .sub foometh :method
580     print "called Foo's foometh\n"
581 .end
583 .sub barmeth :method
584     print "called Foo's barmeth\n"
585 .end
587 .namespace [ 'Bar' ]
589 .sub barmeth :method
590     print "called Bar's barmeth\n"
591 .end
593 .sub __get_string :method
594     .return ("A Bar")
595 .end
597 .namespace [ 'main' ]
599 .sub init 
600     $P1 = newclass 'Foo'
601     addattribute $P1, 'foo1'
602     addattribute $P1, 'foo2'
603     $P2 = subclass $P1, 'Bar'
604     addattribute $P2, 'bar1'
605 .end
607 .sub thread_test_func
608     $I0 = find_type 'Bar'
609     $P0 = new $I0
610     print $P0
611     print "\n"
612     $P0.'barmeth'()
613     $P0.'foometh'()
614     $I0 = isa $P0, 'Integer'
615     print "Integer? "
616     print $I0
617     print "\n"
618     $I0 = isa $P0, 'Foo'
619     print "Foo? "
620     print $I0
621     print "\n"
622     $I0 = isa $P0, 'Bar'
623     print "Bar? "
624     print $I0
625     print "\n"
626 .end
628 .include 'cloneflags.pasm'
629 .sub main :main
630     init()
632     .local pmc thread
633     thread = new ParrotThread
634     .local pmc _thread_func
635     _thread_func = find_global 'main', 'thread_test_func'
636     $I0 = .PARROT_CLONE_CODE
637     bor $I0, $I0, .PARROT_CLONE_CLASSES
638     print "in thread:\n"
639     thread.'run'($I0, _thread_func)
640     thread.'join'()
641     print "in main:\n"
642     _thread_func()
643 .end
644 CODE
645 in thread:
646 A Bar
647 called Bar's barmeth
648 called Foo's foometh
649 Integer? 0
650 Foo? 1
651 Bar? 1
652 in main:
653 A Bar
654 called Bar's barmeth
655 called Foo's foometh
656 Integer? 0
657 Foo? 1
658 Bar? 1
659 OUTPUT
661 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_CLASSES; superclass built-in" );
662 .namespace [ 'Foo' ]
664 .sub foometh :method
665     print "called Foo's foometh\n"
666 .end
668 .sub barmeth :method
669     print "called Foo's barmeth\n"
670 .end
672 .namespace [ 'Bar' ]
674 .sub barmeth :method
675     print "called Bar's barmeth\n"
676 .end
678 .sub __get_string :method
679     .return ("A Bar")
680 .end
682 .namespace [ 'main' ]
684 .sub init 
685     $P0 = getclass .Integer
686     $P1 = subclass $P0, 'Foo'
687     addattribute $P1, 'foo1'
688     addattribute $P1, 'foo2'
689     $P2 = subclass $P1, 'Bar'
690     addattribute $P2, 'bar1'
691 .end
693 .sub thread_test_func
694     $I0 = find_type 'Bar'
695     $P0 = new $I0
696     print $P0
697     print "\n"
698     $P0.'barmeth'()
699     $P0.'foometh'()
700     $I0 = isa $P0, 'Integer'
701     print "Integer? "
702     print $I0
703     print "\n"
704     $I0 = isa $P0, 'Foo'
705     print "Foo? "
706     print $I0
707     print "\n"
708     $I0 = isa $P0, 'Bar'
709     print "Bar? "
710     print $I0
711     print "\n"
712 .end
714 .include 'cloneflags.pasm'
715 .sub main :main
716     init()
718     .local pmc thread
719     thread = new ParrotThread
720     .local pmc _thread_func
721     _thread_func = find_global 'main', 'thread_test_func'
722     $I0 = .PARROT_CLONE_CODE
723     bor $I0, $I0, .PARROT_CLONE_CLASSES
724     print "in thread:\n"
725     thread.'run'($I0, _thread_func)
726     thread.'join'()
727     print "in main:\n"
728     _thread_func()
729 .end
730 CODE
731 in thread:
732 A Bar
733 called Bar's barmeth
734 called Foo's foometh
735 Integer? 1
736 Foo? 1
737 Bar? 1
738 in main:
739 A Bar
740 called Bar's barmeth
741 called Foo's foometh
742 Integer? 1
743 Foo? 1
744 Bar? 1
745 OUTPUT
747 pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_GLOBALS| CLONE_HLL" );
748 .HLL 'Test', ''
749 .sub setup 
750     $P0 = new .Integer
751     $P0 = 42
752     store_global 'x', $P0
753 .end
755 .include 'interpinfo.pasm'
756 .sub test
757     $P0 = find_global 'x'
758     if $P0 == 42 goto okay1
759     print "not "
760 okay1:
761     print "ok 1\n"
762     $P1 = get_root_namespace
763     $P1 = $P1['test']
764     $P1 = $P1['x']
765     $P1 = 43
766     if $P0 == 43 goto okay2
767     print "not "
768 okay2:
769     print "ok 2\n"
770 .end
772 .HLL '', ''
774 .include 'cloneflags.pasm'
776 .sub main :main
777     .local pmc setup
778     .local pmc test
779     setup = get_root_namespace
780     setup = setup['test']
781     test = setup['test']
782     setup = setup['setup']
783     setup()
785     .local pmc thread
786     .local int flags
787     thread = new ParrotThread
788     flags = .PARROT_CLONE_CODE
789     bor flags, flags, .PARROT_CLONE_GLOBALS
790     bor flags, flags, .PARROT_CLONE_HLL
791     print "in thread:\n"
792     thread.'run'(flags, test)
793     thread.'join'()
794     print "in main:\n"
795     test()
796 .end
797 CODE
798 in thread:
799 ok 1
800 ok 2
801 in main:
802 ok 1
803 ok 2
804 OUTPUT
806 pir_output_unlike( <<'CODE', qr/not/, "globals + constant table subs issue" );
807 .namespace [ 'Foo' ]
809 .include 'interpinfo.pasm'
810 .sub 'is'
811     .param pmc what
812     .param pmc expect
813     .local pmc number
814     number = global 'test_num'
815     if what == expect goto okay
816     print "# got:      "
817     print what
818     print "\n"
819     print "# expected: "
820     print expect
821     print "\nnot ok "
822     print number
823     print "\n"
824     $P0 = interpinfo .INTERPINFO_CURRENT_CONT
825 loop:
826     $I0 = defined $P0
827     if $I0 == 0 goto done
828     print "    "
829     print $P0
830     print "\n"
831     $P0 = $P0.'continuation'()
832     branch loop
833 done:
834     .return ()
835 okay:
836     print "ok "
837     print number
838     inc number
839     print "\n"
840 .end
842 .sub setup
843     $P0 = new Integer
844     $P0 = 1
845     store_global 'foo', $P0
846 .end
848 .sub _check_sanity
849     $P0 = global 'foo'
850     $P1 = find_global 'Foo', 'foo'
851     is($P0, $P1)
852 .end
854 .sub mutate
855     $P0 = new Integer
856     $P0 = 2
857     store_global 'foo', $P0
858 .end
860 .sub check_sanity
861     _check_sanity()
862     $P0 = global '_check_sanity'
863     $P0()
864     $P0 = find_global 'Foo', '_check_sanity'
865     $P0()
866 .end
868 .sub _check_value
869     .param int value
870     $P0 = global 'foo'
871     is($P0, value)
872 .end
874 .sub check_value
875     .param int value
876     _check_value(value)
877     $P0 = global '_check_value'
878     $P0(value)
879     $P0 = find_global 'Foo', '_check_value'
880     $P0(value)
881 .end
883 .sub full_check
884     .const .Sub c_setup = 'setup'
885     .const .Sub c_sanity = 'check_sanity'
886     .const .Sub c_mutate = 'mutate'
887     .const .Sub c_value = 'check_value'
889     .local pmc g_setup
890     g_setup = find_global 'Foo', 'setup'
891     .local pmc g_sanity
892     g_sanity = find_global 'Foo', 'check_sanity'
893     .local pmc g_mutate
894     g_mutate = find_global 'Foo', 'mutate'
895     .local pmc g_value
896     g_value = find_global 'Foo', 'check_value'
898     c_setup()
899     c_sanity()
900     g_sanity()
901     c_value(1)
902     g_value(1)
903     c_mutate()
904     c_value(2)
905     g_value(2)
906     c_sanity()
907     g_sanity()
909     g_setup()
910     c_sanity()
911     g_sanity()
912     c_value(1)
913     g_value(1)
914     g_mutate()
915     c_value(2)
916     g_value(2)
917     c_sanity()
918     g_sanity()
919 .end
923 .sub main :main
924     $P0 = new Integer 
925     $P0 = 1
926     store_global 'test_num', $P0
927     
928     .const .Sub _check = 'full_check'
929     _check()
931     $P0 = new ParrotThread
932     $P0.'run_clone'(_check)
933     $P0.'join'()
934 .end
935 CODE
937 pir_output_is(
938     <<'CODE', <<'OUTPUT', "CLONE_CODE|CLONE_GLOBALS|CLONE_HLL|CLONE_LIBRARIES", todo => 'RT#41373' );
939 .HLL 'Perl', 'perl_group'
941 .include 'interpinfo.pasm'
943 .loadlib 'myops_ops'
945 .sub test
946     .param pmc passed_value
947     .local int PerlIntType
948     .local pmc the_value
949     PerlIntType = find_type 'PerlInt'
950     the_value = new PerlIntType
951     the_value = 42
952     store_global 'Foo', 'x', the_value
953     $I0 = typeof passed_value
954     $I1 = typeof the_value
955     $I0 = $I0 - $I1
956     print $I0
957     print "\n"
958     .local pmc ns
959     ns = get_namespace ['Foo']
960     $P0 = interpinfo .INTERPINFO_CURRENT_SUB
961     ns = $P0.'get_namespace'()
962     ns = ns['Foo']
963     $P0 = ns['x']
964     if $P0 == the_value goto okay
965     print "not "
966 okay:
967     print "ok (equal)\n"
969     $I0 = fortytwo
970     print $I0
971     print "\n"
972 .end
974 .include 'cloneflags.pasm'
976 .sub main :main
977     .local pmc thread
978     .local int flags
979     thread = new ParrotThread
980     flags = .PARROT_CLONE_CODE
981     bor flags, flags, .PARROT_CLONE_GLOBALS
982     bor flags, flags, .PARROT_CLONE_HLL
983     bor flags, flags, .PARROT_CLONE_LIBRARIES
985     .local pmc passed
986     .local int PerlIntType
987     PerlIntType = find_type 'PerlInt'
988     passed = new PerlIntType
989     passed = 15
990     
991     .local pmc thread_func
992     thread_func = global 'test'
993     print "in thread:\n"
994     thread.'run'(flags, thread_func, passed)
995     thread.'join'()
996     print "in main:\n"
997     thread_func(passed)
998 .end
999 CODE
1000 in thread:
1002 ok (equal)
1004 in main:
1006 ok (equal)
1008 OUTPUT
1010 pir_output_is( <<'CODE', <<'OUT', 'multi-threaded strings via SharedRef' );
1011 .sub main :main
1012     .local pmc queue
1013     .local pmc tmp_string
1014     .local pmc shared_ref
1016     queue = new TQueue
1017     tmp_string = new String
1018     tmp_string = "ok 1\n"
1019     shared_ref = new SharedRef, tmp_string
1020     push queue, shared_ref
1021     tmp_string = new String
1022     tmp_string = "ok 2\n"
1023     shared_ref = new SharedRef, tmp_string
1024     push queue, shared_ref
1025     tmp_string = new String
1026     tmp_string = "ok 3\n"
1027     shared_ref = new SharedRef, tmp_string
1028     push queue, shared_ref
1030     .local pmc thread
1031     .local pmc foo
1033     thread = new ParrotThread
1034     foo = global '_foo'
1035     thread.'run_clone'(foo, queue)
1036     thread.'join'()
1037     print "done main\n"
1038 .end
1040 .sub _foo
1041     .param pmc queue
1042     $I0 = queue
1043     print $I0
1044     print "\n"
1045 loop:
1046     $I0 = queue
1047     if $I0 == 0 goto done
1048     shift $P0, queue
1049     print $P0
1050     branch loop
1051 done:
1052     print "done thread\n"
1053 .end
1054 CODE
1056 ok 1
1057 ok 2
1058 ok 3
1059 done thread
1060 done main
1063 SKIP: {
1064     skip( "no shared Strings yet", 2 );
1065     pasm_output_is( <<'CODE', <<'OUT', "thread safe queue strings 1" );
1066     new P10, .TQueue
1067     print "ok 1\n"
1068     set I0, P10
1069     print I0
1070     print "\n"
1071     new P7, .String
1072     set P7, "ok 2\n"
1073     push P10, P7
1074     new P7, .String
1075     set P7, "ok 3\n"
1076     push P10, P7
1077     set I0, P10
1078     print I0
1079     print "\n"
1081     shift P8, P10
1082     print P8
1083     shift P8, P10
1084     print P8
1085     end
1086 CODE
1087 ok 1
1090 ok 2
1091 ok 3
1094     pasm_output_is( <<'CODE', <<'OUT', "multi-threaded strings" );
1095     new P10, .TQueue
1096     new P7, .String
1097     set P7, "ok 1\n"
1098     push P10, P7
1099     new P7, .String
1100     set P7, "ok 2\n"
1101     push P10, P7
1102     new P7, .String
1103     set P7, "ok 3\n"
1104     push P10, P7
1105     set P6, P10
1107     find_global P5, "_foo"
1108     new P2, .ParrotThread
1109     callmethod "thread3"
1110     set I5, P2
1111     getinterp P2
1112     callmethod "join"
1113     print "done main\n"
1114     end
1116 .pcc_sub _foo:
1117     set I0, P6
1118     print I0
1119     print "\n"
1120 loop:
1121     set I0, P6
1122     unless I0, ex
1123     shift P8, P6
1124     print P8
1125     branch loop
1127     print "done thread\n"
1128     returncc
1129 CODE
1131 ok 1
1132 ok 2
1133 ok 3
1134 done thread
1135 done main
1139 # Local Variables:
1140 #   mode: cperl
1141 #   cperl-indent-level: 4
1142 #   fill-column: 100
1143 # End:
1144 # vim: expandtab shiftwidth=4: