issue256.t 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. #! /usr/bin/env perl
  2. # http://code.google.com/p/perl-compiler/issues/detail?id=256
  3. # initialize all global vars
  4. use strict;
  5. BEGIN {
  6. unshift @INC, 't';
  7. require "test.pl";
  8. }
  9. use Test::More tests => 8;
  10. my $pv_vars = {';' => "\34",
  11. '"' => " ",
  12. #"\\" => undef,
  13. #',' => undef,
  14. #'/' => "/n",
  15. '^A' => undef,
  16. '^L' => "\f",
  17. ':' => " \n-",
  18. '^' => "STDOUT_TOP",
  19. '~' => "STDOUT"};
  20. my $iv_vars = {'^H' => 0,
  21. '|' => 0,
  22. '%' => 0,
  23. '-' => 60,
  24. '=' => 60,
  25. #'{^UNICODE}' => 0,
  26. #'{^UTF8LOCALE}' => 1
  27. };
  28. my $script = '';
  29. $script .= sprintf('BEGIN{ $%s = "a"} $%s = "a"; print qq{not ok - \$%s = $%s\n} if $%s ne "a";'."\n",
  30. $_, $_, $_, $_, $_) for keys %$pv_vars;
  31. $script .= sprintf('BEGIN{ $%s = 1} $%s = 1; print qq{not ok - \$%s = $%s\n} if $%s != 1;'."\n",
  32. $_, $_, $_, $_, $_) for keys %$iv_vars;
  33. $script .= 'BEGIN{ $\\ = "\n"; } $\\ = "\n"; print qq{not ok - \$\\ = $\\\n} if $\\ ne "\n";'."\n";
  34. $script .= qq(print "ok\\n";);
  35. ctestok(1,'C,-O3','ccode256i',$script,'#256 initialize most global vars');
  36. ctestok(2,'C,-O3','ccode256i',
  37. 'BEGIN{$, = " "; } $, = " "; print $, eq " " ? "ok\n" : qq{not ok - \$, = $,\n}',
  38. '#256 initialize $,');
  39. # need -C -CL switches to set UNICODE
  40. if ($] >= 5.010001) {
  41. ctestok(3,'C,-O3 -C','ccode231i',
  42. 'print ${^UNICODE} ? "ok" : "not ok", " - \${^UNICODE} = ${^UNICODE}\n";',
  43. '#231 initialize ${^UNICODE}');
  44. ctestok(4,'C,-O3 -CL','ccode231i',
  45. 'print ${^UTF8LOCALE} == 1 ? "ok\n" : qq{not ok - \${^UTF8LOCALE} = ${^UTF8LOCALE}\n};',
  46. '#231 initialize ${^UTF8LOCALE}');
  47. } else {
  48. ok 1, "skip -C with <5.10.1";
  49. ok 1, "skip -CL with <5.10.1";
  50. }
  51. ctestok(5,'C,-O3','ccode306i',<<'EOF', '#306 localize RS $/'); # see also #314
  52. package foo; sub check_dol_slash { print ($/ eq "\n" ? "ok" : "not ok") ; print "\n"} sub begin_local { local $/;} ; package main; BEGIN { foo::begin_local() } foo::check_dol_slash();
  53. EOF
  54. ctestok(6,'C,-O3','ccode314i',<<'EOF', '#314 localize and set RS $/ = "b" (sv->gv magic)');
  55. open FOO, ">", "ccode314.tmp"; print FOO "abc"; close FOO; open FOO, "<", "ccode314.tmp"; { local $/="b"; $in=<FOO>; if ($in eq "ab") { print "ok\n" } else { print qq(separator: "$/"\n\$/ is "$/"\nFAIL: "$in"\n)}}; unlink "ccode314.tmp";
  56. EOF
  57. ctestok(7,'C,-O3','ccode306i',<<'EOF', '#256 initialize RS $/');
  58. BEGIN{ $/ = "1"; } print "ok\n" if $/ == "1"
  59. EOF
  60. ctestok(8,'C,-O3','ccode318i',<<'EOF', '#318 localize and set ORS $\ = "b"');
  61. { local $\ = "ok" ; print "" }
  62. EOF