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