t/pmc/sub.t

   1 #! perl
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use Test::More;
  10 use Parrot::Test::Util 'create_tempfile';
  11
  12 use Parrot::Test tests => 70;
  13 use Parrot::Config;
  14
  15 =head1 NAME
  16
  17 t/pmc/sub.t - Subroutine PMCs
  18
  19 =head1 SYNOPSIS
  20
  21     % prove t/pmc/sub.t
  22
  23 =head1 DESCRIPTION
  24
  25 Tests the creation and invocation of C<Sub>, C<Closure> and
  26 C<Continuation> PMCs.
  27
  28 =cut
  29
  30 my @todo;
  31
  32 pasm_output_is( <<'CODE', <<'OUTPUT', "PASM subs - invokecc" );
  33     .const 'Sub' P0 = "func"
  34
  35     set I5, 3
  36     set_args "0", I5
  37     invokecc P0
  38     print I5
  39     print "\n"
  40     end
  41
  42 .pcc_sub func:
  43     get_params "0", I5
  44     print I5
  45     print "\n"
  46
  47     eq I5, 0, endfunc
  48     dec I5
  49
  50 .include "interpinfo.pasm"
  51     interpinfo P0, .INTERPINFO_CURRENT_SUB
  52     set_args "0", I5
  53     invokecc P0  # recursive invoke
  54
  55 endfunc:
  56     returncc
  57 CODE
  58 3
  59 2
  60 1
  61 0
  62 3
  63 OUTPUT
  64
  65 pasm_output_is( <<'CODE', <<'OUTPUT', "Continuation" );
  66     new P5, ['Integer']
  67     set P5, 3
  68     set_global "foo", P5
  69     new P1, ['Continuation']
  70     set_addr P1, endcont
  71 endcont:
  72     get_global P4, "foo"
  73     print "here "
  74     print P4
  75     print "\n"
  76     unless P4, done
  77     dec P4
  78     set_global "foo", P4
  79     print "going to cont\n"
  80     clone P0, P1
  81     invokecc P0
  82 done:
  83     print "done\n"
  84     end
  85
  86 CODE
  87 here 3
  88 going to cont
  89 here 2
  90 going to cont
  91 here 1
  92 going to cont
  93 here 0
  94 done
  95 OUTPUT
  96
  97 pasm_output_is( <<'CODE', <<'OUTPUT', "definedness of Continuation" );
  98     new P1, ['Continuation']
  99     defined I1, P1
 100     print I1
 101     print "\n"
 102     set_addr P1, cont
 103     defined I1, P1
 104     print I1
 105     print "\n"
 106     end
 107
 108 cont:
 109     print "I'm a very boring continuation"
 110     end
 111
 112 CODE
 113 0
 114 1
 115 OUTPUT
 116
 117 pasm_output_is( <<'CODE', <<'OUTPUT', "pcc sub" );
 118     get_global P0, "_the_sub"
 119     defined I0, P0
 120     if I0, ok
 121     print "not "
 122 ok:
 123     print "ok 1\n"
 124     invokecc P0
 125     say "back"
 126     end
 127 .pcc_sub _the_sub:
 128     print "in sub\n"
 129     returncc
 130 CODE
 131 ok 1
 132 in sub
 133 back
 134 OUTPUT
 135
 136 pasm_output_is( <<'CODE', <<'OUTPUT', "pcc sub, tail call" );
 137     get_global P0, "_the_sub"
 138     defined I0, P0
 139     if I0, ok
 140     print "not "
 141 ok:
 142     print "ok 1\n"
 143     invokecc P0
 144     say "back"
 145     end
 146
 147 .pcc_sub _the_sub:
 148     print "in sub\n"
 149     get_global P0, "_next_sub"
 150     get_addr I0, P0
 151     jump I0
 152     print "never here\n"
 153
 154 .pcc_sub _next_sub:
 155     print "in next sub\n"
 156     returncc
 157     print "never here\n"
 158     end
 159 CODE
 160 ok 1
 161 in sub
 162 in next sub
 163 back
 164 OUTPUT
 165
 166 my ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 167 print $TEMP <<'EOF';
 168   .pcc_sub _sub1:
 169   say "in sub1"
 170   end
 171 EOF
 172 close $TEMP;
 173
 174 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode call sub" );
 175 .pcc_sub _main:
 176     say "main"
 177     load_bytecode "$temp_pasm"
 178     say "loaded"
 179     get_global P0, "_sub1"
 180     defined I0, P0
 181     if I0, ok1
 182     print "not "
 183 ok1:
 184     say "found sub"
 185     invokecc P0
 186     say "never"
 187     end
 188 CODE
 189 main
 190 loaded
 191 found sub
 192 in sub1
 193 OUTPUT
 194
 195 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 196
 197 print $TEMP <<'EOF';
 198   .pcc_sub _sub1:
 199   say "in sub1"
 200   returncc
 201 EOF
 202 close $TEMP;
 203
 204 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode call sub, ret" );
 205 .pcc_sub _main:
 206     say "main"
 207     load_bytecode "$temp_pasm"
 208     say "loaded"
 209     get_global P0, "_sub1"
 210     defined I0, P0
 211     if I0, ok1
 212     print "not "
 213 ok1:
 214     say "found sub"
 215     invokecc P0
 216     say "back"
 217     end
 218 CODE
 219 main
 220 loaded
 221 found sub
 222 in sub1
 223 back
 224 OUTPUT
 225
 226 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 227
 228 print $TEMP <<'EOF';
 229   .pcc_sub _sub1:
 230   say "in sub1"
 231   returncc
 232   .pcc_sub _sub2:
 233   say "in sub2"
 234   returncc
 235 EOF
 236 close $TEMP;
 237
 238 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode call different subs, ret" );
 239 .pcc_sub _main:
 240     say "main"
 241     load_bytecode "$temp_pasm"
 242     say "loaded"
 243     get_global P0, "_sub1"
 244     defined I0, P0
 245     if I0, ok1
 246     print "not "
 247 ok1:
 248     say "found sub1"
 249     set P10, P0
 250     invokecc P0
 251     say "back"
 252     get_global P0, "_sub2"
 253     defined I0, P0
 254     if I0, ok2
 255     print "not "
 256 ok2:
 257     say "found sub2"
 258     invokecc P0
 259     say "back"
 260     set P0, P10
 261     invokecc P0
 262     say "back"
 263     end
 264 CODE
 265 main
 266 loaded
 267 found sub1
 268 in sub1
 269 back
 270 found sub2
 271 in sub2
 272 back
 273 in sub1
 274 back
 275 OUTPUT
 276
 277 my (undef, $temp_pbc)  = create_tempfile( SUFFIX => '.pbc', UNLINK => 1 );
 278
 279 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm);
 280
 281 pir_output_is( <<"CODE", <<'OUTPUT', "load_bytecode Sx" );
 282 .sub main :main
 283     \$S0 = '$temp_pasm'
 284     load_bytecode \$S0
 285     _sub1()
 286     \$S0 = '$temp_pbc'
 287     load_bytecode \$S0
 288     _sub2()
 289 .end
 290 CODE
 291 in sub1
 292 in sub2
 293 OUTPUT
 294
 295 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode PBC call different subs, ret" );
 296 .pcc_sub _main:
 297     say "main"
 298     load_bytecode "$temp_pasm"
 299     say "loaded"
 300     get_global P0, "_sub1"
 301     defined I0, P0
 302     if I0, ok1
 303     print "not "
 304 ok1:
 305     say "found sub1"
 306     set P10, P0
 307     invokecc P0
 308     say "back"
 309     get_global P0, "_sub2"
 310     defined I0, P0
 311     if I0, ok2
 312     print "not "
 313 ok2:
 314     say "found sub2"
 315     invokecc P0
 316     say "back"
 317     set P0, P10
 318     invokecc P0
 319     say "back"
 320     end
 321 CODE
 322 main
 323 loaded
 324 found sub1
 325 in sub1
 326 back
 327 found sub2
 328 in sub2
 329 back
 330 in sub1
 331 back
 332 OUTPUT
 333
 334 pasm_output_is( <<'CODE', <<'OUTPUT', "equality of closures" );
 335 .pcc_sub main:
 336       .const 'Sub' P3 = "f1"
 337       newclosure P0, P3
 338       clone P1, P0
 339       eq P0, P1, OK1
 340       print "not "
 341 OK1:  print "ok 1\n"
 342
 343       .const 'Sub' P4 = "f2"
 344       newclosure P2, P4
 345       eq P0, P2, BAD2
 346       branch OK2
 347 BAD2: print "not "
 348 OK2:  print "ok 2\n"
 349       end
 350
 351 .pcc_sub :outer(main) f1:
 352       print "Test\n"
 353       end
 354
 355 .pcc_sub :outer(main) f2:
 356       new P1, ['Undef']
 357       end
 358 CODE
 359 ok 1
 360 ok 2
 361 OUTPUT
 362
 363 pasm_output_is( <<'CODE', <<'OUTPUT', "equality of subs" );
 364       .const 'Sub' P0 = "f1"
 365       clone P1, P0
 366       eq P0, P1, OK1
 367       print "not "
 368 OK1:  print "ok 1\n"
 369
 370       .const 'Sub' P2 = "f2"
 371       clone P1, P0
 372       eq P0, P2, BAD2
 373       branch OK2
 374 BAD2: print "not "
 375 OK2:  print "ok 2\n"
 376       end
 377
 378 .pcc_sub f1:
 379       print "Test\n"
 380       end
 381
 382 .pcc_sub f2:
 383       new P1, ['Undef']
 384       end
 385 CODE
 386 ok 1
 387 ok 2
 388 OUTPUT
 389
 390 pasm_output_is( <<'CODE', <<'OUT', "MAIN pragma, syntax only" );
 391 .pcc_sub :main _main:
 392     print "ok\n"
 393     end
 394 CODE
 395 ok
 396 OUT
 397
 398 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 399
 400 print $TEMP <<'EOF';
 401   .pcc_sub :load _sub1:
 402   say "in sub1"
 403   returncc
 404 EOF
 405 close $TEMP;
 406
 407 pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load' );
 408 .pcc_sub _main:
 409     say "main"
 410     load_bytecode "$temp_pasm"
 411     say "back"
 412     end
 413 CODE
 414 main
 415 in sub1
 416 back
 417 OUTPUT
 418
 419 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 420
 421 print $TEMP <<'EOF';
 422   .pcc_sub _error:
 423   say "error"
 424   .pcc_sub :load _sub1:
 425   say "in sub1"
 426   returncc
 427 EOF
 428 close $TEMP;
 429
 430 pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load second sub' );
 431 .pcc_sub _main:
 432     say "main"
 433     load_bytecode "$temp_pasm"
 434     say "back"
 435     end
 436 CODE
 437 main
 438 in sub1
 439 back
 440 OUTPUT
 441
 442 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm );
 443
 444 pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load in pbc' );
 445 .pcc_sub _main:
 446     say "main"
 447     load_bytecode "$temp_pbc"
 448     say "back"
 449     end
 450 CODE
 451 main
 452 in sub1
 453 back
 454 OUTPUT
 455
 456 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 457
 458 print $TEMP <<'EOF';
 459   .pcc_sub :load _sub1:
 460   say "in sub1"
 461   returncc
 462   .pcc_sub _sub2:
 463   print "in sub2\n"
 464   returncc
 465 EOF
 466 close $TEMP;
 467
 468 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun first" );
 469 .pcc_sub _main:
 470     say "main"
 471     load_bytecode "$temp_pasm"
 472     say "loaded"
 473     get_global P0, "_sub2"
 474     invokecc P0
 475     say "back"
 476     end
 477 CODE
 478 main
 479 in sub1
 480 loaded
 481 in sub2
 482 back
 483 OUTPUT
 484
 485 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm );
 486
 487 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun first in pbc" );
 488 .pcc_sub _main:
 489     say "main"
 490     load_bytecode "$temp_pbc"
 491     say "loaded"
 492     get_global P0, "_sub2"
 493     invokecc P0
 494     say "back"
 495     end
 496 CODE
 497 main
 498 in sub1
 499 loaded
 500 in sub2
 501 back
 502 OUTPUT
 503
 504 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 505
 506 print $TEMP <<'EOF';
 507   .pcc_sub _sub1:
 508   say "in sub1"
 509   returncc
 510   .pcc_sub :load _sub2:
 511   print "in sub2\n"
 512   returncc
 513 EOF
 514 close $TEMP;
 515
 516 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun second" );
 517 .pcc_sub _main:
 518     say "main"
 519     load_bytecode "$temp_pasm"
 520     say "loaded"
 521     get_global P0, "_sub1"
 522     invokecc P0
 523     say "back"
 524     end
 525 CODE
 526 main
 527 in sub2
 528 loaded
 529 in sub1
 530 back
 531 OUTPUT
 532
 533 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm );
 534
 535 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun second in pbc" );
 536 .pcc_sub _main:
 537     say "main"
 538     load_bytecode "$temp_pbc"
 539     say "loaded"
 540     get_global P0, "_sub1"
 541     invokecc P0
 542     say "back"
 543     end
 544 CODE
 545 main
 546 in sub2
 547 loaded
 548 in sub1
 549 back
 550 OUTPUT
 551
 552 ($TEMP, $temp_pasm) = create_tempfile( SUFFIX => '.pasm', UNLINK => 1 );
 553
 554 print $TEMP <<'EOF';
 555   .pcc_sub :load _sub1:
 556   say "in sub1"
 557   returncc
 558   .pcc_sub :load _sub2:
 559   print "in sub2\n"
 560   returncc
 561 EOF
 562 close $TEMP;
 563
 564 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun both" );
 565 .pcc_sub _main:
 566     say "main"
 567     load_bytecode "$temp_pasm"
 568     say "loaded"
 569     get_global P0, "_sub1"
 570     invokecc P0
 571     say "back"
 572     end
 573 CODE
 574 main
 575 in sub1
 576 in sub2
 577 loaded
 578 in sub1
 579 back
 580 OUTPUT
 581
 582 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm );
 583
 584 pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun both in pbc" );
 585 .pcc_sub _main:
 586     say "main"
 587     load_bytecode "$temp_pbc"
 588     say "loaded"
 589     get_global P0, "_sub1"
 590     invokecc P0
 591     say "back"
 592     end
 593 CODE
 594 main
 595 in sub1
 596 in sub2
 597 loaded
 598 in sub1
 599 back
 600 OUTPUT
 601
 602 pasm_output_is( <<'CODE', <<'OUTPUT', ':main pragma' );
 603 .pcc_sub _first:
 604     print "first\n"
 605     returncc
 606 .pcc_sub :main _main:
 607     say "main"
 608     end
 609 CODE
 610 main
 611 OUTPUT
 612
 613 pasm_output_is( <<'CODE', <<'OUTPUT', 'two :main pragmas' );
 614 .pcc_sub _first:
 615     print "first\n"
 616     returncc
 617 .pcc_sub :main _main:
 618     say "main"
 619     end
 620 .pcc_sub :main _second:
 621     print "second\n"
 622     returncc
 623 CODE
 624 main
 625 OUTPUT
 626
 627 pasm_output_is( <<'CODE', <<'OUTPUT', ':main pragma call subs' );
 628 .pcc_sub _first:
 629     print "first\n"
 630     returncc
 631 .pcc_sub _second:
 632     print "second\n"
 633     returncc
 634 .pcc_sub :main _main:
 635     say "main"
 636     get_global P0, "_first"
 637     invokecc P0
 638     get_global P0, "_second"
 639     invokecc P0
 640     end
 641 CODE
 642 main
 643 first
 644 second
 645 OUTPUT
 646
 647 pir_error_output_like( <<'CODE', <<'OUTPUT', "implicit :main with wrong # args." );
 648 .sub a
 649   .param int op1
 650   .param int op2
 651 .end
 652 CODE
 653 /too few positional arguments: 1 passed, 2 \(or more\) expected/
 654 OUTPUT
 655
 656 pir_error_output_like( <<'CODE', <<'OUTPUT', "explicit :main with wrong # args." );
 657 .sub a :main
 658   .param int op1
 659   .param int op2
 660 .end
 661 CODE
 662 /too few positional arguments: 1 passed, 2 \(or more\) expected/
 663 OUTPUT
 664
 665 ($TEMP, $temp_pasm) = create_tempfile(UNLINK => 1);
 666 print $TEMP <<'EOF';
 667 .sub _sub1 :load
 668   say "in sub1"
 669   returncc
 670 .end
 671 EOF
 672 close $TEMP;
 673
 674 pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load first sub - pir' );
 675 .pcc_sub _main:
 676     say "main"
 677     load_bytecode "$temp_pasm"
 678     say "back"
 679     end
 680 CODE
 681 main
 682 in sub1
 683 back
 684 OUTPUT
 685
 686 ($TEMP, $temp_pasm) = create_tempfile(UNLINK => 1);
 687 print $TEMP <<'EOF';
 688 .sub _foo
 689   print "error\n"
 690 .end
 691
 692 # :load or other pragmas are only evaluated on the first
 693 # instruction of a subroutine
 694 .sub _sub1 :load
 695   say "in sub1"
 696   returncc
 697 .end
 698 EOF
 699 close $TEMP;
 700
 701 pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load second sub - pir' );
 702 .pcc_sub _main:
 703     say "main"
 704     load_bytecode "$temp_pasm"
 705     say "back"
 706     end
 707 CODE
 708 main
 709 in sub1
 710 back
 711 OUTPUT
 712
 713 ($TEMP, my $temp_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 714
 715 print $TEMP <<'EOF';
 716 .sub _foo
 717   print "error\n"
 718 .end
 719 .sub _sub1
 720   say "in sub1"
 721   returncc
 722 .end
 723 EOF
 724 close $TEMP;
 725
 726 pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode no :load - pir' );
 727 .pcc_sub _main:
 728     say "main"
 729     load_bytecode "$temp_pir"
 730     say "back"
 731     end
 732 CODE
 733 main
 734 back
 735 OUTPUT
 736
 737 pir_output_like( <<'CODE', '/Stringifying an Undef PMC/', 'warn on in main' );
 738 .sub _main :main
 739 .include "warnings.pasm"
 740     warningson .PARROT_WARNINGS_UNDEF_FLAG
 741     _f1()
 742 .end
 743 .sub _f1
 744     $P0 = new ['Undef']
 745     print $P0
 746 .end
 747 CODE
 748
 749 pir_output_is( <<'CODE', <<'OUTPUT', "warn on in sub" );
 750 .sub _main :main
 751 .include "warnings.pasm"
 752     _f1()
 753     $P0 = new ['Undef']
 754     print $P0
 755     print "ok\n"
 756 .end
 757 .sub _f1
 758     warningson .PARROT_WARNINGS_UNDEF_FLAG
 759 .end
 760 CODE
 761 ok
 762 OUTPUT
 763
 764 pir_output_like( <<'CODE', <<'OUTPUT', "warn on in sub, turn off in f2" );
 765 .sub _main :main
 766 .include "warnings.pasm"
 767     _f1()
 768     $P0 = new ['Undef']
 769     say "back"
 770     print $P0
 771     print "ok\n"
 772 .end
 773 .sub _f1
 774     warningson .PARROT_WARNINGS_UNDEF_FLAG
 775     _f2()
 776     $P0 = new ['Undef']
 777     print $P0
 778 .end
 779 .sub _f2
 780     warningsoff .PARROT_WARNINGS_UNDEF_FLAG
 781 .end
 782 CODE
 783 /Stringifying an Undef PMC
 784 .*
 785 back
 786 ok/
 787 OUTPUT
 788
 789 pasm_output_is( <<'CODE', <<'OUTPUT', "sub names" );
 790 .pcc_sub main:
 791     .include "interpinfo.pasm"
 792     interpinfo P20, .INTERPINFO_CURRENT_SUB
 793     print P20
 794     print "\n"
 795     get_global P0, "the_sub"
 796     invokecc P0
 797     interpinfo P20, .INTERPINFO_CURRENT_SUB
 798     print P20
 799     print "\n"
 800     end
 801 .pcc_sub the_sub:
 802     interpinfo P20, .INTERPINFO_CURRENT_SUB
 803     print P20
 804     print "\n"
 805     interpinfo P1, .INTERPINFO_CURRENT_CONT
 806     returncc
 807 CODE
 808 main
 809 the_sub
 810 main
 811 OUTPUT
 812
 813 pasm_output_is( <<'CODE', <<'OUTPUT', "sub names w MAIN" );
 814 .pcc_sub dummy:
 815     print "never\n"
 816     noop
 817 .pcc_sub :main main:
 818     .include "interpinfo.pasm"
 819     interpinfo P20, .INTERPINFO_CURRENT_SUB
 820     print P20
 821     print "\n"
 822     get_global P0, "the_sub"
 823     invokecc P0
 824     interpinfo P20, .INTERPINFO_CURRENT_SUB
 825     print P20
 826     print "\n"
 827     end
 828 .pcc_sub the_sub:
 829     interpinfo P20, .INTERPINFO_CURRENT_SUB
 830     print P20
 831     print "\n"
 832     interpinfo P1, .INTERPINFO_CURRENT_CONT
 833     returncc
 834 CODE
 835 main
 836 the_sub
 837 main
 838 OUTPUT
 839
 840 pir_output_is( <<'CODE', <<'OUTPUT', "caller introspection via interp" );
 841 .sub main :main
 842 .include "interpinfo.pasm"
 843     # this test will fail when run with -Oc
 844     # as the call chain is cut down with tail calls
 845     foo()
 846
 847     $P0 = get_hll_global ["Bar"], "foo"
 848     $P0()
 849     print "ok\n"
 850 .end
 851 .sub foo
 852     print "main foo\n"
 853     $P0 = get_hll_global ["Bar"], "bar"
 854     $P0()
 855 .end
 856 .namespace ["Bar"]
 857 .sub bar
 858     print "Bar bar\n"
 859     $P1 = getinterp
 860     $P0 = $P1["sub"]
 861     print "subname: "
 862     print $P0
 863     print "\n"
 864     foo()
 865 .end
 866 .sub foo
 867     print "Bar foo\n"
 868     $P1 = getinterp
 869     $I0 = 0
 870     push_eh tb_end
 871 tb_loop:
 872     $P0 = $P1["sub"; $I0]
 873     print "caller "
 874     print $I0
 875     print " "
 876     print $P0
 877     print "\n"
 878     inc $I0
 879     goto tb_loop
 880 tb_end:
 881 .end
 882 CODE
 883 main foo
 884 Bar bar
 885 subname: bar
 886 Bar foo
 887 caller 0 foo
 888 caller 1 bar
 889 caller 2 foo
 890 caller 3 main
 891 Bar foo
 892 caller 0 foo
 893 caller 1 main
 894 ok
 895 OUTPUT
 896
 897 pir_output_is( <<'CODE', <<'OUT', ':immediate :postcomp' );
 898 .sub optc :immediate :postcomp
 899     print "initial\n"
 900 .end
 901 .sub _main :main
 902     say "main"
 903 .end
 904 CODE
 905 initial
 906 initial
 907 main
 908 OUT
 909
 910 pir_output_like( <<'CODE', <<'OUTPUT', ':anon' );
 911 .sub main :main
 912     "foo"()
 913     print "ok\n"
 914     $P0 = get_global "new"
 915     $I0 = defined $P0
 916     print $I0
 917     print "\n"
 918     $P0 = get_global "foo"
 919     unless null $P0 goto foo
 920     print "nofoo\n"
 921   foo:
 922 .end
 923
 924 .sub "foo" :anon
 925     print "foo\n"
 926     "new"()
 927 .end
 928
 929 .sub "new"
 930     print "new\n"
 931 .end
 932 CODE
 933 /^foo
 934 new
 935 ok
 936 1
 937 nofoo/
 938 OUTPUT
 939
 940 ($TEMP, my $l1_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 941 (my $l1_pbc         = $l1_pir) =~ s/\.pir/.pbc/;
 942
 943 print $TEMP <<'EOF';
 944 .sub l11 :load
 945     print "l11\n"
 946 .end
 947
 948 .sub l12 :load
 949     print "l12\n"
 950 .end
 951 EOF
 952 close $TEMP;
 953
 954 ($TEMP, my $l2_pir) = create_tempfile( SUFFIX => '.pir', UNLINK => 1 );
 955 (my $l2_pbc         = $l2_pir) =~ s/\.pir/.pbc/;
 956
 957 print $TEMP <<'EOF';
 958 .sub l21 :load
 959     print "l21\n"
 960 .end
 961
 962 .sub l22 :load
 963     print "l22\n"
 964 .end
 965 EOF
 966 close $TEMP;
 967
 968 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $l1_pbc, $l1_pir);
 969 system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $l2_pbc, $l2_pir);
 970
 971 pir_output_is( <<"CODE", <<'OUTPUT', 'multiple :load' );
 972 .sub main :main
 973     say "main 1"
 974     load_bytecode "$l1_pir"
 975     load_bytecode "$l2_pir"
 976     say "main 2"
 977     load_bytecode "$l1_pbc" # these have to be ignored
 978     load_bytecode "$l2_pbc"
 979     say "main 3"
 980 .end
 981 CODE
 982 main 1
 983 l11
 984 l12
 985 l21
 986 l22
 987 main 2
 988 main 3
 989 OUTPUT
 990
 991 unlink( $l1_pbc, $l2_pbc );
 992
 993 pir_output_is( <<'CODE', <<'OUTPUT', "immediate code as const" );
 994 .sub make_phi :immediate :anon
 995     $N0 = sqrt 5
 996     $N0 += 1
 997     $N0 /= 2
 998     $P0 = new ['Float']
 999     $P0 = $N0
1000     .return ($P0)
1001 .end
1002
1003 .sub main :main
1004     .const 'Sub' phi = "make_phi"
1005     print phi
1006     print "\n"
1007 .end
1008 CODE
1009 1.61803398874989
1010 OUTPUT
1011
1012 pir_output_is( <<'CODE', <<'OUTPUT', "immediate code as const - obj" );
1013 .sub make_obj :immediate :anon
1014     .local pmc cl, o
1015     cl = newclass "Foo"
1016     addattribute cl, 'x'
1017     o = new ['Foo']
1018     $P0 = new ['String']
1019     $P0 = "ok 1\n"
1020     setattribute o, 'x', $P0
1021     .return (o)
1022 .end
1023
1024 .sub main :main
1025     .const 'Sub' o = "make_obj"
1026     $P0 = getattribute o, 'x'
1027     print $P0
1028 .end
1029
1030 CODE
1031 ok 1
1032 OUTPUT
1033
1034 pir_output_is( <<'CODE', <<'OUTPUT', "__get_regs_used 1" );
1035 .sub main :main
1036     .local pmc m
1037     .include "interpinfo.pasm"
1038     m = interpinfo .INTERPINFO_CURRENT_SUB
1039     $I0 = m."__get_regs_used"('N')
1040     print $I0
1041     $I0 = m."__get_regs_used"('I')
1042     print $I0
1043     $I0 = m."__get_regs_used"('S')
1044     print $I0
1045     $I0 = m."__get_regs_used"('P')
1046     print $I0
1047     print "\n"
1048 .end
1049
1050 CODE
1051 0101
1052 OUTPUT
1053
1054 pir_output_is( <<'CODE', <<'OUTPUT', "__get_regs_used 2" );
1055 .sub main :main
1056     foo()
1057 .end
1058 .sub foo
1059     .local pmc m
1060     .include "interpinfo.pasm"
1061     m = interpinfo .INTERPINFO_CURRENT_SUB
1062     set $N0, 1.0
1063     set $N7, 1.0
1064     add $N7, $N7, $N0
1065     set $I9, 1
1066     add $I10, $I9, $I9
1067     $I0 = m."__get_regs_used"('N')
1068     print $I0
1069     $I0 = m."__get_regs_used"('I')
1070     print $I0
1071     $I0 = m."__get_regs_used"('S')
1072     print $I0
1073     $I0 = m."__get_regs_used"('P')
1074     print $I0
1075     print "\n"
1076 .end
1077
1078
1079 CODE
1080 2301
1081 OUTPUT
1082
1083 pir_output_like( <<"CODE", <<'OUTPUT', 'warn on in main' );
1084 .sub 'test' :main
1085 .include "warnings.pasm"
1086     warningson .PARROT_WARNINGS_UNDEF_FLAG
1087     _f1()
1088 .end
1089 .sub _f1
1090     \$P0 = new ['Undef']
1091     print \$P0
1092 .end
1093 CODE
1094 /Stringifying an Undef PMC/
1095 OUTPUT
1096
1097 pir_output_is( <<"CODE", <<'OUTPUT', 'warn on in sub' );
1098 .sub 'test' :main
1099 .include "warnings.pasm"
1100     _f1()
1101     \$P0 = new ['Undef']
1102     print \$P0
1103     say "ok"
1104 .end
1105 .sub _f1
1106     warningson .PARROT_WARNINGS_UNDEF_FLAG
1107 .end
1108 CODE
1109 ok
1110 OUTPUT
1111
1112 pir_output_like( <<"CODE", <<'OUTPUT', 'warn on in sub, turn off in f2' );
1113 .sub 'test' :main
1114 .include "warnings.pasm"
1115     _f1()
1116     \$P0 = new ['Undef']
1117     say "back"
1118     print \$P0
1119     say "ok"
1120 .end
1121 .sub _f1
1122     warningson .PARROT_WARNINGS_UNDEF_FLAG
1123     _f2()
1124     \$P0 = new ['Undef']
1125     print \$P0
1126 .end
1127 .sub _f2
1128     warningsoff .PARROT_WARNINGS_UNDEF_FLAG
1129 .end
1130 CODE
1131 /Stringifying an Undef PMC/
1132 OUTPUT
1133
1134 pir_output_is( <<'CODE', <<'OUTPUT', ':postcomp' );
1135 .sub main :main
1136     say 'main'
1137 .end
1138 .sub pc :postcomp
1139     say 'pc'
1140 .end
1141 .sub im :immediate
1142     say 'im'
1143 .end
1144 .sub pc2 :postcomp
1145     say 'pc2'
1146 .end
1147 .sub im2 :immediate
1148     say 'im2'
1149 .end
1150 CODE
1151 im
1152 im2
1153 pc
1154 pc2
1155 main
1156 OUTPUT
1157
1158 # see also #38964
1159 pir_output_is( <<'CODE', <<'OUTPUT', 'unicode sub names, compilation' );
1160 .sub unicode:"\u7777"
1161    print "ok\n"
1162 .end
1163 CODE
1164 ok
1165 OUTPUT
1166
1167 pir_output_is( <<'CODE', <<'OUTPUT', 'unicode sub names, invocation' );
1168 .sub unicode:"\u7777"
1169     print "ok\n"
1170 .end
1171
1172 .sub test :main
1173     unicode:"\u7777"()
1174 .end
1175 CODE
1176 ok
1177 OUTPUT
1178
1179 pir_output_is( <<'CODE', <<'OUTPUT', 'unicode sub names, dynamic' );
1180 .sub unicode:"\u7777"
1181     print "ok\n"
1182 .end
1183
1184 .sub test :main
1185     $P1 = find_name unicode:"\u7777"
1186     $P1()
1187 .end
1188 CODE
1189 ok
1190 OUTPUT
1191
1192 pir_output_is( <<'CODE', <<'OUTPUT', 'unicode sub names' );
1193 .sub unicode:"\u7777"
1194     print "ok\n"
1195 .end
1196
1197 .sub test :main
1198     # unicode:"\u7777" ends up as a string nicode:"\u7777
1199     # (or it did, in r12860)
1200     $P1 = find_name 'nicode:"\u7777'
1201     unless null $P1 goto bad
1202     print "not found\n"
1203   bad:
1204 .end
1205 CODE
1206 not found
1207 OUTPUT
1208
1209 pir_output_is( <<'CODE', <<'OUTPUT', 'unicode sub constant' );
1210 .sub main :main
1211     .const 'Sub' s = unicode:"\u7777"
1212     s()
1213 .end
1214
1215 .sub unicode:"\u7777"
1216    print "ok\n"
1217 .end
1218 CODE
1219 ok
1220 OUTPUT
1221
1222 pir_output_is( <<'CODE', <<'OUTPUT', 'literal \u in sub name (not unicode)' );
1223 .sub '\u2193'
1224     say 'ok'
1225 .end
1226 CODE
1227 ok
1228 OUTPUT
1229
1230 pir_error_output_like( <<'CODE', qr/Null PMC access in invoke()/, 'invoking null pmc' );
1231 .sub main :main
1232     null $P0
1233     $P0()
1234 .end
1235 CODE
1236
1237 pir_output_is( <<'CODE', <<'OUTPUT', ":init" );
1238 .sub a :init
1239     print "in inited\n"
1240 .end
1241
1242 .sub main :main
1243     say "main"
1244 .end
1245 CODE
1246 in inited
1247 main
1248 OUTPUT
1249
1250 pir_output_is( <<'CODE', <<'OUTPUT', 'assign' );
1251 .sub main :main
1252     $P0 = get_global 'ok'
1253
1254     $P1 = new ['Undef']
1255     assign $P1, $P0
1256
1257     $P1()
1258 .end
1259
1260 .sub ok
1261     say "ok"
1262 .end
1263 CODE
1264 ok
1265 OUTPUT
1266
1267 pir_output_is( <<'CODE', <<'OUTPUT', 'assign w/:outer' );
1268 .sub main :main
1269     $P0 = get_global 'ok'
1270
1271     $P1 = new ['Undef']
1272     assign $P1, $P0
1273
1274     $P1()
1275 .end
1276
1277 .sub ok :outer('main')
1278     say "ok"
1279 .end
1280 CODE
1281 ok
1282 OUTPUT
1283
1284 pir_output_is( <<'CODE', <<'OUTPUT', 'get_namespace()' );
1285 .sub main :main
1286     $P0 = get_global 'main'
1287     $P0 = $P0.'get_namespace'()
1288     $P0 = $P0.'get_name'()
1289     $S0 = join ';', $P0
1290     say $S0
1291
1292     $P0 = get_global ['Foo'; 'Bar'], 'foo'
1293     $P0 = $P0.'get_namespace'()
1294     $P0 = $P0.'get_name'()
1295     $S0 = join ';', $P0
1296     say $S0
1297 .end
1298
1299 .namespace ['Foo'; 'Bar']
1300 .sub foo
1301     noop
1302 .end
1303 CODE
1304 parrot
1305 parrot;Foo;Bar
1306 OUTPUT
1307
1308 pir_output_is( <<'CODE', <<'OUTPUT', 'arity()' );
1309 .sub main :main
1310     $P0 = get_global 'none'
1311     $I0 = $P0.'arity'()
1312     say $I0
1313
1314     $P0 = get_global 'one'
1315     $I0 = $P0.'arity'()
1316     say $I0
1317
1318     $P0 = get_global 'four'
1319     $I0 = $P0.'arity'()
1320     say $I0
1321
1322     $P0 = get_global 'all_slurpy'
1323     $I0 = $P0.'arity'()
1324     say $I0
1325
1326     $P0 = get_global 'some_optional'
1327     $I0 = $P0.'arity'()
1328     say $I0
1329
1330     $P0 = get_global 'some_named'
1331     $I0 = $P0.'arity'()
1332     say $I0
1333
1334     $P0 = get_global 'allsorts'
1335     $I0 = $P0.'arity'()
1336     say $I0
1337 .end
1338
1339 .sub none
1340 .end
1341
1342 .sub one
1343     .param int a
1344 .end
1345
1346 .sub four
1347     .param int a
1348     .param pmc b
1349     .param string c
1350     .param num d
1351 .end
1352
1353 .sub all_slurpy
1354     .param pmc s :slurpy
1355 .end
1356
1357 .sub some_optional
1358     .param int a
1359     .param int b :optional
1360     .param int bo :opt_flag
1361     .param int c
1362 .end
1363
1364 .sub some_named
1365     .param int b
1366     .param int a :named('a')
1367     .param int c :named('c')
1368 .end
1369
1370 .sub allsorts
1371     .param int c
1372     .param int b :optional
1373     .param int bo :opt_flag
1374     .param pmc s :slurpy
1375     .param int a :named('a')
1376 .end
1377 CODE
1378 0
1379 1
1380 4
1381 0
1382 2
1383 3
1384 2
1385 OUTPUT
1386
1387 pir_output_is( <<'CODE', <<'OUTPUT', 'set_outer' );
1388 .sub main :main
1389     $P0 = get_hll_global "example_outer"
1390     $P1 = get_hll_global "example_inner"
1391     $P1.'set_outer'($P0)
1392     $P0()
1393     $P1()
1394 .end
1395
1396 .sub example_outer
1397     .lex "Foo", $P0
1398     $P0 = new ['String']
1399     $P0 = 'I can has outer?'
1400 .end
1401
1402 .sub example_inner
1403     $P0 = find_lex "Foo"
1404     say $P0
1405 .end
1406 CODE
1407 I can has outer?
1408 OUTPUT
1409
1410 pir_output_is( <<'CODE', <<'OUTPUT', 'set_outer and eval' );
1411 .sub main :main
1412     'example_outer'()
1413 .end
1414
1415 .sub 'example_outer'
1416     .lex "Foo", $P0
1417     $P0 = new ['String']
1418     $P0 = 'I can has outer from eval?'
1419
1420     $S1 = <<'PIR'
1421 .sub example_inner
1422     $P0 = find_lex "Foo"
1423     say $P0
1424 .end
1425 PIR
1426     $P1 = compreg 'PIR'
1427     $P1 = $P1($S1)
1428
1429     $P3 = new 'ParrotInterpreter'
1430     $P3 = $P3['sub']
1431     $P2 = $P1[0]
1432     $P2.'set_outer'($P3)
1433
1434     $P1()
1435 .end
1436 CODE
1437 I can has outer from eval?
1438 OUTPUT
1439
1440 $ENV{TEST_PROG_ARGS} ||= '';
1441 @todo = $ENV{TEST_PROG_ARGS} =~ /--run-pbc/
1442     ? ( todo => 'lexicals not thawed properly from PBC, TT #1171' )
1443     : ();
1444 pir_output_is( <<'CODE', <<'OUTPUT', ':outer with identical sub names', @todo );
1445 .sub 'main' :main
1446     $P0 = get_hll_global ['ABC'], 'outer'
1447     $P0('ABC lex')
1448
1449     $P0 = get_hll_global ['DEF'], 'outer'
1450     $P0('DEF lex')
1451 .end
1452
1453 .namespace ['ABC']
1454 .sub 'outer' :subid('abc_outer')
1455     .param pmc x
1456     .lex '$abc', x
1457     say 'ABC::outer'
1458     'inner'()
1459 .end
1460
1461 .sub 'inner' :outer('abc_outer')
1462     say 'ABC::inner'
1463     $P0 = find_lex '$abc'
1464     say $P0
1465 .end
1466
1467 .namespace ['DEF']
1468 .sub 'outer' :subid('def_outer')
1469     .param pmc x
1470     .lex '$def', x
1471     say 'DEF::outer'
1472     'inner'()
1473 .end
1474
1475 .sub 'inner' :outer('def_outer')
1476     say 'DEF::inner'
1477     $P0 = find_lex '$def'
1478     say $P0
1479 .end
1480 CODE
1481 ABC::outer
1482 ABC::inner
1483 ABC lex
1484 DEF::outer
1485 DEF::inner
1486 DEF lex
1487 OUTPUT
1488
1489 pir_output_is( <<'CODE', <<'OUTPUT', ':subid and identical string constants' );
1490 .sub 'main'
1491     'foo'()
1492     'bar'()
1493 .end
1494
1495 .sub 'foo'
1496     new $P0, ['String']
1497     assign $P0, "abc"
1498     say $P0
1499 .end
1500
1501 .sub 'bar'  :subid("abc")
1502     new $P0, ['String']
1503     assign $P0, "abc"
1504     say $P0
1505 .end
1506 CODE
1507 abc
1508 abc
1509 OUTPUT
1510
1511 pir_output_is( <<'CODE', <<'OUTPUT', 'copy sub to self' );
1512 .sub 'main'
1513     $P0 = new ['Sub']
1514     assign $P0, $P0
1515     say 'no segfault'
1516 .end
1517 CODE
1518 no segfault
1519 OUTPUT
1520
1521 pir_output_is( <<'CODE', <<'OUTPUT', 'get_string null check' );
1522 .sub 'main'
1523     $P0 = new ['Sub']
1524     $S0 = $P0
1525     say 'ok'
1526 .end
1527 CODE
1528 ok
1529 OUTPUT
1530
1531 pir_output_is( <<'CODE', <<'OUTPUT', 'use of :init sub pointed to by a :outer in compreg' );
1532 .sub 'comptest'
1533     $S0 = <<'PIR'
1534 .sub 'MAIN'
1535     say 'MAIN'
1536     .return ()
1537 .end
1538 .namespace ['XYZ']
1539 .sub 'BEGIN' :init
1540     say 'XYZ::BEGIN'
1541     .return ()
1542 .end
1543 .sub 'foo' :outer('BEGIN')
1544     say 'XYZ::foo'
1545     .return ()
1546 .end
1547 PIR
1548     $P0 = compreg 'PIR'
1549     say "got compiler"
1550     $P1 = $P0($S0)
1551     say "compiled"
1552     $P1()
1553     say "lived"
1554 .end
1555 CODE
1556 got compiler
1557 XYZ::BEGIN
1558 compiled
1559 MAIN
1560 lived
1561 OUTPUT
1562
1563 pir_output_is( <<'CODE', <<'OUTPUT', '.get_subid' );
1564 .sub 'main'
1565     .const 'Sub' foo = 'foo'
1566     $S0 = foo.'get_subid'()
1567     say $S0
1568
1569     $P0 = get_global 'bar'
1570     $S0 = $P0.'get_subid'()
1571     say $S0
1572
1573     $P0 = get_global 'baz'
1574     $S0 = $P0.'get_subid'()
1575     say $S0
1576 .end
1577
1578 .sub '' :subid('foo')
1579     say 'foo'
1580 .end
1581
1582 .sub 'bar'
1583     say 'bar'
1584 .end
1585
1586 .sub 'baz' :subid('bazsubid')
1587     say 'baz'
1588 .end
1589 CODE
1590 foo
1591 bar
1592 bazsubid
1593 OUTPUT
1594
1595 pir_output_is( <<'CODE', <<'OUTPUT', 'Thaw PIR subclass', todo => 'See TT #132' );
1596 .sub main :main
1597
1598   $P0 = get_class 'Sub'
1599   $P1 = subclass $P0, 'myProc'
1600
1601   .local pmc pirC
1602   pirC = compreg 'PIR'
1603
1604   .local string code
1605   code = <<"END_CODE"
1606
1607 .sub bar
1608   say "hi"
1609 .end
1610 END_CODE
1611
1612   .local pmc compiled
1613   compiled = pirC(code)
1614   compiled = compiled[0] # just want the first executable sub here.
1615
1616   compiled() # works
1617
1618   .local pmc sub
1619   sub = new 'myProc'
1620   assign sub, compiled
1621   sub() # works
1622
1623   $S0 = freeze sub
1624   say "frozen"
1625   $P2 = thaw $S0
1626   say "thawed"
1627   $P2()
1628 .end
1629 CODE
1630 hi
1631 hi
1632 frozen
1633 thawed
1634 hi
1635 OUTPUT
1636
1637 pir_output_is( <<'CODE', <<'OUTPUT', 'init_pmc' );
1638 .sub 'main'
1639     .local pmc init, s, regs, arg_info
1640
1641     init = new ['Hash']
1642     init['start_offs']  = 42
1643     init['end_offs']    = 115200
1644
1645     regs = new ['FixedIntegerArray']
1646     regs = 4
1647     regs[0] = 1
1648     regs[1] = 2
1649     regs[2] = 6
1650     regs[3] = 24
1651     init['n_regs_used'] = regs
1652
1653     arg_info = new ['Hash']
1654     arg_info['pos_required']    = 1
1655     arg_info['pos_optional']    = 1
1656     arg_info['pos_slurpy']      = 2
1657     arg_info['named_required']  = 3
1658     arg_info['named_optional']  = 5
1659     arg_info['named_slurpy']    = 8
1660     init['arg_info'] = arg_info
1661
1662     s = new ['Sub'], init
1663
1664     $I0 = s.'start_offs'()
1665     print 'start_offs '
1666     say $I0
1667
1668     print 'end_offs '
1669     $I0 = s.'end_offs'()
1670     say $I0
1671
1672     # Check n_regs_used
1673     $I0 = s.'__get_regs_used'('I')
1674     print 'I regs '
1675     say $I0
1676
1677     $I0 = s.'__get_regs_used'('N')
1678     print 'N regs '
1679     say $I0
1680
1681     $I0 = s.'__get_regs_used'('S')
1682     print 'S regs '
1683     say $I0
1684
1685     $I0 = s.'__get_regs_used'('P')
1686     print 'P regs '
1687     say $I0
1688
1689     # Check arg_info
1690     $P0 = inspect s, 'pos_required'
1691     print 'pos_required '
1692     say $P0
1693
1694     $P0 = inspect s, 'pos_optional'
1695     print 'pos_optional '
1696     say $P0
1697
1698     $P0 = inspect s, 'pos_slurpy'
1699     print 'pos_slurpy '
1700     say $P0
1701
1702     $P0 = inspect s, 'named_required'
1703     print 'named_required '
1704     say $P0
1705
1706     $P0 = inspect s, 'named_optional'
1707     print 'named_optional '
1708     say $P0
1709
1710     $P0 = inspect s, 'named_slurpy'
1711     print 'named_slurpy '
1712     say $P0
1713
1714     # We need more tests for other fields. And more accessors obviously.
1715 .end
1716 CODE
1717 start_offs 42
1718 end_offs 115200
1719 I regs 1
1720 N regs 2
1721 S regs 6
1722 P regs 24
1723 pos_required 1
1724 pos_optional 1
1725 pos_slurpy 2
1726 named_required 3
1727 named_optional 5
1728 named_slurpy 8
1729 OUTPUT
1730
1731 pir_output_is( <<'CODE', <<'OUT', 'interface' );
1732 .sub 'main' :main
1733     .const 'Sub' $P0 = "main"
1734
1735     $I0 = does $P0, 'scalar'
1736     say $I0 # Sub does not scalar
1737     $I0 = does $P0, 'invokable'
1738     say $I0 # Sub does invokable
1739     $I0 = does $P0, 'no_interface'
1740     say $I0 # Sub does not no_interface
1741 .end
1742 CODE
1743 0
1744 1
1745 0
1746 OUT
1747
1748
1749 # Local Variables:
1750 #   mode: cperl
1751 #   cperl-indent-level: 4
1752 #   fill-column: 100
1753 # End:
1754 # vim: expandtab shiftwidth=4: