| 1 | #!./perl |
| 2 | |
| 3 | print "1..46\n"; |
| 4 | |
| 5 | $x = 'x'; |
| 6 | |
| 7 | print "#1 :$x: eq :x:\n"; |
| 8 | if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";} |
| 9 | |
| 10 | $x = $#; # this is the register $# |
| 11 | |
| 12 | if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";} |
| 13 | |
| 14 | $x = $#x; |
| 15 | |
| 16 | if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";} |
| 17 | |
| 18 | $x = '\\'; # '; |
| 19 | |
| 20 | if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";} |
| 21 | |
| 22 | eval 'while (0) { |
| 23 | print "foo\n"; |
| 24 | } |
| 25 | /^/ && (print "ok 5\n"); |
| 26 | '; |
| 27 | |
| 28 | eval '$foo{1} / 1;'; |
| 29 | if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";} |
| 30 | |
| 31 | eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;'; |
| 32 | |
| 33 | $foo = int($foo * 100 + .5); |
| 34 | if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";} |
| 35 | |
| 36 | print <<'EOF'; |
| 37 | ok 8 |
| 38 | EOF |
| 39 | |
| 40 | $foo = 'ok 9'; |
| 41 | print <<EOF; |
| 42 | $foo |
| 43 | EOF |
| 44 | |
| 45 | eval <<\EOE, print $@; |
| 46 | print <<'EOF'; |
| 47 | ok 10 |
| 48 | EOF |
| 49 | |
| 50 | $foo = 'ok 11'; |
| 51 | print <<EOF; |
| 52 | $foo |
| 53 | EOF |
| 54 | EOE |
| 55 | |
| 56 | print <<`EOS` . <<\EOF; |
| 57 | echo ok 12 |
| 58 | EOS |
| 59 | ok 13 |
| 60 | EOF |
| 61 | |
| 62 | print qq/ok 14\n/; |
| 63 | print qq(ok 15\n); |
| 64 | |
| 65 | print qq |
| 66 | [ok 16\n] |
| 67 | ; |
| 68 | |
| 69 | print q<ok 17 |
| 70 | >; |
| 71 | |
| 72 | print <<; # Yow! |
| 73 | ok 18 |
| 74 | |
| 75 | # previous line intentionally left blank. |
| 76 | |
| 77 | print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n"; |
| 78 | @{[ <<E2 ]} |
| 79 | foo |
| 80 | E2 |
| 81 | E1 |
| 82 | |
| 83 | print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n"; |
| 84 | @{[ |
| 85 | <<E2 |
| 86 | foo |
| 87 | E2 |
| 88 | ]} |
| 89 | E1 |
| 90 | |
| 91 | $foo = FOO; |
| 92 | $bar = BAR; |
| 93 | $foo{$bar} = BAZ; |
| 94 | $ary[0] = ABC; |
| 95 | |
| 96 | print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n"; |
| 97 | |
| 98 | print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n"; |
| 99 | print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n"; |
| 100 | |
| 101 | print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n"; |
| 102 | print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n"; |
| 103 | print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n"; |
| 104 | |
| 105 | # MJD 19980425 |
| 106 | ($X, @X) = qw(a b c d); |
| 107 | print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n"; |
| 108 | print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n"; |
| 109 | |
| 110 | print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n"); |
| 111 | |
| 112 | |
| 113 | $foo = "not ok 30\n"; |
| 114 | $foo =~ s/^not /substr(<<EOF, 0, 0)/e; |
| 115 | Ignored |
| 116 | EOF |
| 117 | print $foo; |
| 118 | |
| 119 | # Tests for new extended control-character variables |
| 120 | # MJD 19990227 |
| 121 | |
| 122 | { my $CX = "\cX"; |
| 123 | my $CXY ="\cXY"; |
| 124 | $ {$CX} = 17; |
| 125 | $ {$CXY} = 23; |
| 126 | if ($ {^XY} != 23) { print "not " } |
| 127 | print "ok 31\n"; |
| 128 | |
| 129 | # Does the syntax where we use the literal control character still work? |
| 130 | if (eval "\$ {\cX}" != 17 or $@) { print "not " } |
| 131 | print "ok 32\n"; |
| 132 | |
| 133 | eval "\$\cN = 24"; # Literal control character |
| 134 | if ($@ or ${"\cN"} != 24) { print "not " } |
| 135 | print "ok 33\n"; |
| 136 | if ($^N != 24) { print "not " } # Control character escape sequence |
| 137 | print "ok 34\n"; |
| 138 | |
| 139 | # Does the old UNBRACED syntax still do what it used to? |
| 140 | if ("$^XY" ne "17Y") { print "not " } |
| 141 | print "ok 35\n"; |
| 142 | |
| 143 | sub XX () { 6 } |
| 144 | $ {"\cN\cXX"} = 119; |
| 145 | $^N = 5; # This should be an unused ^Var. |
| 146 | $N = 5; |
| 147 | # The second caret here should be interpreted as an xor |
| 148 | if (($^N^XX) != 3) { print "not " } |
| 149 | print "ok 36\n"; |
| 150 | # if (($N ^ XX()) != 3) { print "not " } |
| 151 | # print "ok 32\n"; |
| 152 | |
| 153 | # These next two tests are trying to make sure that |
| 154 | # $^FOO is always global; it doesn't make sense to `my' it. |
| 155 | # |
| 156 | |
| 157 | eval 'my $^X;'; |
| 158 | print "not " unless index ($@, 'Can\'t use global $^X in "my"') > -1; |
| 159 | print "ok 37\n"; |
| 160 | # print "($@)\n" if $@; |
| 161 | |
| 162 | eval 'my $ {^XYZ};'; |
| 163 | print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1; |
| 164 | print "ok 38\n"; |
| 165 | # print "($@)\n" if $@; |
| 166 | |
| 167 | # Now let's make sure that caret variables are all forced into the main package. |
| 168 | package Someother; |
| 169 | $^N = 'Someother'; |
| 170 | $ {^Nostril} = 'Someother 2'; |
| 171 | $ {^M} = 'Someother 3'; |
| 172 | package main; |
| 173 | print "not " unless $^N eq 'Someother'; |
| 174 | print "ok 39\n"; |
| 175 | print "not " unless $ {^Nostril} eq 'Someother 2'; |
| 176 | print "ok 40\n"; |
| 177 | print "not " unless $ {^M} eq 'Someother 3'; |
| 178 | print "ok 41\n"; |
| 179 | |
| 180 | |
| 181 | } |
| 182 | |
| 183 | # see if eval '', s///e, and heredocs mix |
| 184 | |
| 185 | sub T { |
| 186 | my ($where, $num) = @_; |
| 187 | my ($p,$f,$l) = caller; |
| 188 | print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/; |
| 189 | print "ok $num\n"; |
| 190 | } |
| 191 | |
| 192 | my $test = 42; |
| 193 | |
| 194 | { |
| 195 | # line 42 "plink" |
| 196 | local $_ = "not ok "; |
| 197 | eval q{ |
| 198 | s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++; |
| 199 | # fuggedaboudit |
| 200 | EOT |
| 201 | print $_, $test++, "\n"; |
| 202 | T('^main:\(eval \d+\):6$', $test++); |
| 203 | # line 1 "plunk" |
| 204 | T('^main:plunk:1$', $test++); |
| 205 | }; |
| 206 | print "# $@\nnot ok $test\n" if $@; |
| 207 | T '^main:plink:53$', $test++; |
| 208 | } |