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