issue54.t 1.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647
  1. #! /usr/bin/env perl
  2. # http://code.google.com/p/perl-compiler/issues/detail?id=54
  3. # pad_swipe error with package pmcs
  4. use strict;
  5. my $name = "ccode54p";
  6. use Test::More tests => 1;
  7. my $pkg = <<"EOF";
  8. package $name;
  9. sub test {
  10. \$abc='ok';
  11. print "\$abc\\n";
  12. }
  13. 1;
  14. EOF
  15. open F, ">", "$name.pm";
  16. print F $pkg;
  17. close F;
  18. my $expected = "ok";
  19. my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
  20. my $Mblib = "-Iblib/arch -Iblib/lib";
  21. if ($] < 5.008) {
  22. system "$runperl -MO=Bytecode,-o$name.pmc $name.pm";
  23. } else {
  24. system "$runperl $Mblib -MO=-qq,Bytecode,-H,-o$name.pmc $name.pm";
  25. }
  26. unless (-e "$name.pmc") {
  27. print "not ok 1 #B::Bytecode failed.\n";
  28. exit;
  29. }
  30. my $runexe = "$runperl $Mblib -I. -M$name -e\"$name\::test\"";
  31. $runexe = "$runperl -MByteLoader -I. -M$name -e\"$name\::test\"" if $] < 5.008;
  32. my $result = `$runexe`;
  33. $result =~ s/\n$//;
  34. SKIP: {
  35. skip "no pmc on 5.6 (yet)", 1 if $] < 5.008;
  36. ok($result eq $expected, "issue54 - pad_swipe error with package pmcs");
  37. }
  38. END {
  39. unlink($name, "$name.pmc", "$name.pm")
  40. if $result eq $expected;
  41. }