t/base/lex.t

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