issue24.t 1.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162
  1. #! /usr/bin/env perl
  2. # http://code.google.com/p/perl-compiler/issues/detail?id=24
  3. use strict;
  4. use Test::More tests => 3;
  5. use Config;
  6. my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/);
  7. my $ITHREADS = ($Config{useithreads});
  8. my $name = "ccode24i";
  9. my $skipped;
  10. my $script = <<'EOF';
  11. my %H; dbmopen(%H,'ccode24i.db',0600); print q(ok);
  12. EOF
  13. open F, ">", "$name.pl";
  14. print F $script;
  15. close F;
  16. my $result;
  17. my $Mblib = $] < 5.007 ? "" : "-Iblib/arch -Iblib/lib"; # 5.6 Bytecode not yet released
  18. my $O = $] >= 5.013005 ? "-Wb=-fno-fold,-fno-warnings" : ""; # reduce bloat
  19. my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
  20. my $expected = `$runperl $name.pl`;
  21. $result = `$runperl $Mblib blib/script/perlcc -r -B $name.pl`;
  22. TODO: { #1
  23. local $TODO = "Bytecode issue 24 dbm (still original compiler)"
  24. if $] < 5.008001 or $result =~ /No dbm on this machine/;
  25. is($result, $expected, "Bytecode dbm fixed with r882, 1.30");
  26. }
  27. unlink("$name.db*");
  28. $Mblib = "-Iblib/arch -Iblib/lib" if $] < 5.007;
  29. TODO: { #2
  30. local $TODO = "B::C issue 24 dbm >=5.12thr or 5.10.0 or 5.6"
  31. if ($] >= 5.012 and $ITHREADS) or $] < 5.007 or $] eq '5.010000';
  32. my $stderr = " 2>&1" if ($^O !~ /^MSWin32|VMS/);
  33. $result = `$runperl $Mblib blib/script/perlcc -r $O $name.pl $stderr`;
  34. if ($result =~ /No dbm on this machine/m) {
  35. ok(1, 'skip - No dbm on this machine');
  36. $skipped++;
  37. } else {
  38. is($result, $expected, "C dbm fixed with r879, 1.30");
  39. }
  40. }
  41. $result = `$runperl $Mblib blib/script/perlcc -r -O $O $name.pl`;
  42. TODO: { #3
  43. # local $TODO = "B::CC issue 24 dbm >5.10" if $] >= 5.010;
  44. if ($skipped) {
  45. ok(1, 'skip - No dbm on this machine');
  46. } else {
  47. is($result, $expected, "CC dbm fixed with r881, XSLoader with 1.32");
  48. }
  49. }
  50. END {
  51. unlink("$name*", "a", "a.out");
  52. }