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