t/op/yadayada.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require './test.pl';
   6     set_up_inc('../lib');
   7 }
   8
   9 use strict;
  10
  11 plan 34;
  12
  13 my $err;
  14 my $err1 = "Unimplemented at $0 line ";
  15 my $err2 = ".\n";
  16
  17 $err = $err1 . ( __LINE__ + 1 ) . $err2;
  18 eval { ... };
  19 is $@, $err, "Execution of ellipsis statement reported 'Unimplemented' code";
  20 $@ = '';
  21
  22 my $i = 0;
  23 is eval { $i++; ...; $i+=10; 123 }, undef;
  24 like $@, qr/\AUnimplemented /;
  25 is $i, 1;
  26
  27 note("RT #122661: Semicolon before ellipsis statement disambiguates to indicate block rather than hash reference");
  28 my @input = (3..5);
  29 my @transformed;
  30 $err = $err1 . ( __LINE__ + 1 ) . $err2;
  31 eval { @transformed = map {; ... } @input; };
  32 is $@, $err, "Disambiguation case 1";
  33 $@ = '';
  34
  35 $err = $err1 . ( __LINE__ + 1 ) . $err2;
  36 eval { @transformed = map {;...} @input; };
  37 is $@, $err, "Disambiguation case 2";
  38 $@ = '';
  39
  40 $err = $err1 . ( __LINE__ + 1 ) . $err2;
  41 eval { @transformed = map {; ...} @input; };
  42 is $@, $err, "Disambiguation case 3";
  43 $@ = '';
  44
  45 $err = $err1 . ( __LINE__ + 1 ) . $err2;
  46 eval { @transformed = map {;... } @input; };
  47 is $@, $err, "Disambiguation case 4";
  48 $@ = '';
  49
  50 note("RT #132150: ... in other contexts is a syntax error");
  51 foreach(
  52         "... + 0", "0 + ...",
  53         "... . 0", "0 . ...",
  54         "... or 1", "1 or ...",
  55         "... if 1", "1 if ...",
  56         '[...]',
  57         'my $a = ...',
  58         '... sub quux {}',
  59 ) {
  60         is eval($_), undef;
  61         like $@, qr/\Asyntax error /;
  62 }
  63
  64 #
  65 # Regression tests, making sure ... is still parsable as an operator.
  66 #
  67 my @lines = split /\n/ => <<'--';
  68
  69 # Check simple range operator.
  70 my @arr = 'A' ... 'D';
  71
  72 # Range operator with print.
  73 print 'D' ... 'A';
  74
  75 # Without quotes, 'D' could be a file handle.
  76 print  D  ...  A ;
  77
  78 # Another possible interaction with a file handle.
  79 print ${\"D"}  ...  A ;
  80 --
  81
  82 foreach my $line (@lines) {
  83     next if $line =~ /^\s*#/ || $line !~ /\S/;
  84     my $mess = qq {Parsing '...' in "$line" as a range operator};
  85     eval qq {
  86        {local *STDOUT; no strict "subs"; $line;}
  87         pass \$mess;
  88         1;
  89     } or do {
  90         my $err = $@;
  91         $err =~ s/\n//g;
  92         fail "$mess ($err)";
  93     }
  94 }