t/op/misc.t

   1 #!./perl
   2
   3 chdir 't' if -d 't';
   4 @INC = "../lib";
   5 $ENV{PERL5LIB} = "../lib";
   6
   7 $|=1;
   8
   9 undef $/;
  10 @prgs = split "\n########\n", <DATA>;
  11 print "1..", scalar @prgs, "\n";
  12
  13 $tmpfile = "misctmp000";
  14 1 while -f ++$tmpfile;
  15 END { unlink $tmpfile if $tmpfile; }
  16
  17 for (@prgs){
  18     my $switch;
  19     if (s/^\s*-\w+//){
  20         $switch = $&;
  21     }
  22     my($prog,$expected) = split(/\nEXPECT\n/, $_);
  23     open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
  24     print TEST $prog, "\n";
  25     close TEST;
  26     $status = $?;
  27     $results = `cat $tmpfile`;
  28     $results =~ s/\n+$//;
  29     $expected =~ s/\n+$//;
  30     if ( $results ne $expected){
  31         print STDERR "PROG: $switch\n$prog\n";
  32         print STDERR "EXPECTED:\n$expected\n";
  33         print STDERR "GOT:\n$results\n";
  34         print "not ";
  35     }
  36     print "ok ", ++$i, "\n";
  37 }
  38
  39 __END__
  40 $cusp = ~0 ^ (~0 >> 1);
  41 $, = " ";
  42 print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
  43 EXPECT
  44 7 0 0 1 !
  45 ########
  46 $foo=undef; $foo->go;
  47 EXPECT
  48 Can't call method "go" without a package or object reference at - line 1.
  49 ########
  50 BEGIN
  51         {
  52             "foo";
  53         }
  54 ########
  55 $array[128]=1
  56 ########
  57 $x=0x0eabcd; print $x->ref;
  58 EXPECT
  59 Can't call method "ref" without a package or object reference at - line 1.
  60 ########
  61 chop ($str .= <STDIN>);
  62 ########
  63 close ($banana);
  64 ########
  65 $x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
  66 EXPECT
  67 25
  68 ########
  69 eval {sub bar {print "In bar";}}
  70 ########
  71 system "./perl -ne 'print if eof' /dev/null"
  72 ########
  73 chop($file = <>);
  74 ########
  75 package N;
  76 sub new {my ($obj,$n)=@_; bless \$n}
  77 $aa=new N 1;
  78 $aa=12345;
  79 print $aa;
  80 EXPECT
  81 12345
  82 ########
  83 %@x=0;
  84 EXPECT
  85 Can't coerce HASH to string in repeat at - line 1.
  86 ########
  87 $_="foo";
  88 printf(STDOUT "%s\n", $_);
  89 EXPECT
  90 foo
  91 ########
  92 push(@a, 1, 2, 3,)
  93 ########
  94 quotemeta ""
  95 ########
  96 for ("ABCDE") {
  97  &sub;
  98 s/./&sub($&)/eg;
  99 print;}
 100 sub sub {local($_) = @_;
 101 $_ x 4;}
 102 EXPECT
 103 Modification of a read-only value attempted at - line 3.
 104 ########
 105 package FOO;sub new {bless {FOO => BAR}};
 106 package main;
 107 use strict vars;
 108 my $self = new FOO;
 109 print $$self{FOO};
 110 EXPECT
 111 BAR
 112 ########
 113 $_="foo";
 114 s/.{1}//s;
 115 print;
 116 EXPECT
 117 oo
 118 ########
 119 print scalar ("foo","bar")
 120 EXPECT
 121 bar
 122 ########
 123 sub by_number { $a <=> $b; };# inline function for sort below
 124 $as_ary{0}="a0";
 125 @ordered_array=sort by_number keys(%as_ary);
 126 ########
 127 sub NewShell
 128 {
 129   local($Host) = @_;
 130   my($m2) = $#Shells++;
 131   $Shells[$m2]{HOST} = $Host;
 132   return $m2;
 133 }
 134
 135 sub ShowShell
 136 {
 137   local($i) = @_;
 138 }
 139
 140 &ShowShell(&NewShell(beach,Work,"+0+0"));
 141 &ShowShell(&NewShell(beach,Work,"+0+0"));
 142 &ShowShell(&NewShell(beach,Work,"+0+0"));
 143 ########
 144    {
 145        package FAKEARRAY;
 146
 147        sub TIEARRAY
 148        { print "TIEARRAY @_\n";
 149          die "bomb out\n" unless $count ++ ;
 150          bless ['foo']
 151        }
 152        sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
 153        sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
 154        sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
 155    }
 156
 157 eval 'tie @h, FAKEARRAY, fred' ;
 158 tie @h, FAKEARRAY, fred ;
 159 EXPECT
 160 TIEARRAY FAKEARRAY fred
 161 TIEARRAY FAKEARRAY fred
 162 DESTROY
 163 ########
 164 BEGIN { die "phooey\n" }
 165 EXPECT
 166 phooey
 167 BEGIN failed--compilation aborted at - line 1.
 168 ########
 169 BEGIN { 1/$zero }
 170 EXPECT
 171 Illegal division by zero at - line 1.
 172 BEGIN failed--compilation aborted at - line 1.
 173 ########
 174 BEGIN { undef = 0 }
 175 EXPECT
 176 Modification of a read-only value attempted at - line 1.
 177 BEGIN failed--compilation aborted at - line 1.
 178 ########
 179 {
 180     package foo;
 181     sub PRINT {
 182         shift;
 183         print join(' ', reverse @_)."\n";
 184     }
 185     sub TIEHANDLE {
 186         bless {}, shift;
 187     }
 188     sub READLINE {
 189         "Out of inspiration";
 190     }
 191     sub DESTROY {
 192         print "and destroyed as well\n";
 193     }
 194 }
 195 {
 196     local(*FOO);
 197     tie(*FOO,'foo');
 198     print FOO "sentence.", "reversed", "a", "is", "This";
 199     print "-- ", <FOO>, " --\n";
 200 }
 201 EXPECT
 202 This is a reversed sentence.
 203 -- Out of inspiration --
 204 and destroyed as well