t/op/lex.t

   1 #!perl
   2
   3 # Tests too complex for t/base/lex.t
   4
   5 use strict;
   6 use warnings;
   7
   8 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
   9
  10 plan(tests => 25);
  11
  12 {
  13     no warnings 'deprecated';
  14     print <<;   # Yow!
  15 ok 1
  16
  17     # previous line intentionally left blank.
  18
  19     my $yow = "ok 2";
  20     print <<;   # Yow!
  21 $yow
  22
  23     # previous line intentionally left blank.
  24 }
  25
  26 curr_test(3);
  27
  28
  29 {
  30     my %foo = (aap => "monkey");
  31     my $foo = '';
  32     is("@{[$foo{'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript');
  33     is("@{[$foo {'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript - test for [perl #70091]');
  34
  35 # Original bug report [perl #70091]
  36 #  #!perl
  37 #  use warnings;
  38 #  my %foo;
  39 #  my $foo = '';
  40 #  (my $tmp = $foo) =~ s/^/$foo {$0}/e;
  41 #  __END__
  42 #
  43 #  This program causes a segfault with 5.10.0 and 5.10.1.
  44 #
  45 #  The space between '$foo' and '{' is essential, which is why piping
  46 #  it through perl -MO=Deparse "fixes" it.
  47 #
  48
  49 }
  50
  51 {
  52  delete local $ENV{PERL_UNICODE};
  53  fresh_perl_is(
  54   'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"',
  55   'Constant(\N{a}) unknown at - line 1, within string' . "\n"
  56  ."Execution of - aborted due to compilation errors.\n",
  57    { stderr => 1 },
  58   'correct output (and no crash) when charnames cannot load for \N{...}'
  59  );
  60 }
  61 fresh_perl_is(
  62   'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"};
  63           $^H{charnames} = "foo" } "\N{a}"',
  64   "Undefined subroutine &main::foo called at - line 2.\n"
  65  ."Propagated at - line 2, within string\n"
  66  ."Execution of - aborted due to compilation errors.\n",
  67    { stderr => 1 },
  68   'no crash when charnames cannot load and %^H holds string'
  69 );
  70 fresh_perl_is(
  71   'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"};
  72           $^H{charnames} = \"foo" } "\N{a}"',
  73   "Not a CODE reference at - line 2.\n"
  74  ."Propagated at - line 2, within string\n"
  75  ."Execution of - aborted due to compilation errors.\n",
  76    { stderr => 1 },
  77   'no crash when charnames cannot load and %^H holds string reference'
  78 );
  79
  80 # not fresh_perl_is, as it seems to hide the error
  81 is runperl(
  82     nolib => 1, # -Ilib may also hide the error
  83     progs => [
  84       '*{',
  85       '         XS::APItest::gv_fetchmeth_type()',
  86       '}'
  87     ],
  88     stderr => 1,
  89    ),
  90   "Undefined subroutine &XS::APItest::gv_fetchmeth_type called at -e line "
  91  ."2.\n",
  92   'no buffer corruption with multiline *{...expr...}'
  93 ;
  94
  95 $_ = "rhubarb";
  96 is ${no strict; \$_}, "rhubarb", '${no strict; ...}';
  97 is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb',
  98   'map{no strict;...}';
  99
 100 # [perl #123753]
 101 fresh_perl_is(
 102   '$eq = "ok\n"; print $' . "\0eq\n",
 103   "ok\n",
 104    { stderr => 1 },
 105   '$ <null> ident'
 106 );
 107 fresh_perl_is(
 108   '@eq = "ok\n"; print @' . "\0eq\n",
 109   "ok\n",
 110    { stderr => 1 },
 111   '@ <null> ident'
 112 );
 113 fresh_perl_is(
 114   '%eq = ("o"=>"k\n"); print %' . "\0eq\n",
 115   "ok\n",
 116    { stderr => 1 },
 117   '% <null> ident'
 118 );
 119 fresh_perl_is(
 120   'sub eq { "ok\n" } print &' . "\0eq\n",
 121   "ok\n",
 122    { stderr => 1 },
 123   '& <null> ident'
 124 );
 125 fresh_perl_is(
 126   '$eq = "ok\n"; print ${*' . "\0eq{SCALAR}}\n",
 127   "ok\n",
 128    { stderr => 1 },
 129   '* <null> ident'
 130 );
 131 SKIP: {
 132     skip "Different output on EBCDIC (presumably)", 2 if ord("A") != 65;
 133     fresh_perl_is(
 134       qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish,
 135 Bareword found where operator expected at - line 1, near ""ab}"ax"
 136         (Missing operator before ax?)
 137 syntax error at - line 1, near ""ab}"ax"
 138 Unrecognized character \\x8A; marked by <-- HERE after ab}"ax;&\0z<-- HERE near column 12 at - line 1.
 139 gibberish
 140        { stderr => 1 },
 141       'gibberish containing &\0z - used to crash [perl #123753]'
 142     );
 143     fresh_perl_is(
 144       qq'"ab}"ax;&{+z}\x8Ao}\x82x;', <<gibberish,
 145 Bareword found where operator expected at - line 1, near ""ab}"ax"
 146         (Missing operator before ax?)
 147 syntax error at - line 1, near ""ab}"ax"
 148 Unrecognized character \\x8A; marked by <-- HERE after }"ax;&{+z}<-- HERE near column 14 at - line 1.
 149 gibberish
 150        { stderr => 1 },
 151       'gibberish containing &{+z} - used to crash [perl #123753]'
 152     );
 153 }
 154
 155 fresh_perl_is(
 156   '/$a[/<<a',
 157   "Missing right curly or square bracket at - line 1, within pattern\n" .
 158   "syntax error at - line 1, at EOF\n" .
 159   "Execution of - aborted due to compilation errors.\n",
 160    { stderr => 1 },
 161   '/$a[/<<a with no newline [perl #123712]'
 162 );
 163 fresh_perl_is(
 164   '/$a[m||/<<a',
 165   "Missing right curly or square bracket at - line 1, within pattern\n" .
 166   "syntax error at - line 1, at EOF\n" .
 167   "Execution of - aborted due to compilation errors.\n",
 168    { stderr => 1 },
 169   '/$a[m||/<<a with no newline [perl #123712]'
 170 );
 171
 172 fresh_perl_is(
 173   '"@{"',
 174   "Missing right curly or square bracket at - line 1, within string\n" .
 175   "syntax error at - line 1, at EOF\n" .
 176   "Execution of - aborted due to compilation errors.\n",
 177    { stderr => 1 },
 178   '"@{" [perl #123712]'
 179 );
 180
 181 fresh_perl_is(
 182   '/$0{}/',
 183   'syntax error at - line 1, near "{}"' . "\n" .
 184   "Execution of - aborted due to compilation errors.\n",
 185    { stderr => 1 },
 186   '/$0{}/ with no newline [perl #123802]'
 187 );
 188 fresh_perl_is(
 189   '"\L\L"',
 190   'syntax error at - line 1, near "\L\L"' . "\n" .
 191   "Execution of - aborted due to compilation errors.\n",
 192    { stderr => 1 },
 193   '"\L\L" with no newline [perl #123802]'
 194 );
 195 fresh_perl_is(
 196   '<\L\L>',
 197   'syntax error at - line 1, near "\L\L"' . "\n" .
 198   "Execution of - aborted due to compilation errors.\n",
 199    { stderr => 1 },
 200   '<\L\L> with no newline [perl #123802]'
 201 );
 202
 203 is eval "qq'@\x{ff13}'", "\@\x{ff13}",
 204   '"@<fullwidth digit>" [perl #123963]';
 205
 206 fresh_perl_is(
 207   "s;\@{<<a;\n",
 208   "Can't find string terminator \"a\" anywhere before EOF at - line 1.\n",
 209    { stderr => 1 },
 210   's;@{<<a; [perl #123995]'
 211 );