1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!./perl
print "1..35\n";
$x = 'x';
print "#1 :$x: eq :x:\n";
if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
$x = $#; # this is the register $#
if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
$x = $#x;
if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
$x = '\\'; # ';
if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
eval 'while (0) {
print "foo\n";
}
/^/ && (print "ok 5\n");
';
eval '$foo{1} / 1;';
if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";}
eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
$foo = int($foo * 100 + .5);
if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";}
print <<'EOF';
ok 8
EOF
$foo = 'ok 9';
print <<EOF;
$foo
EOF
eval <<\EOE, print $@;
print <<'EOF';
ok 10
EOF
$foo = 'ok 11';
print <<EOF;
$foo
EOF
EOE
print <<`EOS` . <<\EOF;
echo ok 12
EOS
ok 13
EOF
print qq/ok 14\n/;
print qq(ok 15\n);
print qq
[ok 16\n]
;
print q<ok 17
>;
print <<; # Yow!
ok 18
# previous line intentionally left blank.
print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n";
@{[ <<E2 ]}
foo
E2
E1
print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n";
@{[
<<E2
foo
E2
]}
E1
$foo = FOO;
$bar = BAR;
$foo{$bar} = BAZ;
$ary[0] = ABC;
print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n";
print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n";
print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
# MJD 19980425
($X, @X) = qw(a b c d);
print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
$foo = "not ok 30\n";
$foo =~ s/^not /substr(<<EOF, 0, 0)/e;
Ignored
EOF
print $foo;
# see if eval '', s///e, and heredocs mix
sub T {
my ($where, $num) = @_;
my ($p,$f,$l) = caller;
print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/;
print "ok $num\n";
}
my $test = 31;
{
# line 42 "plink"
local $_ = "not ok ";
eval q{
s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++;
# fuggedaboudit
EOT
print $_, $test++, "\n";
T('^main:\(eval \d+\):6$', $test++);
# line 1 "plunk"
T('^main:plunk:1$', $test++);
};
print "# $@\nnot ok $test\n" if $@;
T '^main:plink:53$', $test++;
}
|
