t/cmd/subval.t

   1 #!./perl
   2
   3 # $RCSfile: subval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:13 $
   4
   5 sub foo1 {
   6     'true1';
   7     if ($_[0]) { 'true2'; }
   8 }
   9
  10 sub foo2 {
  11     'true1';
  12     if ($_[0]) { return 'true2'; } else { return 'true3'; }
  13     'true0';
  14 }
  15
  16 sub foo3 {
  17     'true1';
  18     unless ($_[0]) { 'true2'; }
  19 }
  20
  21 sub foo4 {
  22     'true1';
  23     unless ($_[0]) { 'true2'; } else { 'true3'; }
  24 }
  25
  26 sub foo5 {
  27     'true1';
  28     'true2' if $_[0];
  29 }
  30
  31 sub foo6 {
  32     'true1';
  33     'true2' unless $_[0];
  34 }
  35
  36 print "1..36\n";
  37
  38 if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
  39 if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
  40 if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
  41 if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
  42
  43 if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
  44 if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
  45 if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
  46 if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
  47
  48 if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
  49 if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
  50 if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
  51 if (&foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
  52
  53 # Now test to see that recursion works using a Fibonacci number generator
  54
  55 sub fib {
  56     my($arg) = @_;
  57     my($foo);
  58     $level++;
  59     if ($arg <= 2) {
  60         $foo = 1;
  61     }
  62     else {
  63         $foo = &fib($arg-1) + &fib($arg-2);
  64     }
  65     $level--;
  66     $foo;
  67 }
  68
  69 @good = (0,1,1,2,3,5,8,13,21,34,55,89);
  70
  71 for ($i = 1; $i <= 10; $i++) {
  72     $foo = $i + 12;
  73     if (&fib($i) == $good[$i]) {
  74         print "ok $foo\n";
  75     }
  76     else {
  77         print "not ok $foo\n";
  78     }
  79 }
  80
  81 sub ary1 {
  82     (1,2,3);
  83 }
  84
  85 print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n";
  86
  87 print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n";
  88
  89 sub ary2 {
  90     do {
  91         return (1,2,3);
  92         (3,2,1);
  93     };
  94     0;
  95 }
  96
  97 print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n";
  98
  99 $x = join(':',&ary2);
 100 print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
 101
 102 sub somesub {
 103     local($num,$P,$F,$L) = @_;
 104     ($p,$f,$l) = caller;
 105     print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n";
 106 }
 107
 108 &somesub(27, 'main', __FILE__, __LINE__);
 109
 110 package foo;
 111 &main'somesub(28, 'foo', __FILE__, __LINE__);
 112
 113 package main;
 114 $i = 28;
 115 open(FOO,">Cmd_subval.tmp");
 116 print FOO "blah blah\n";
 117 close FOO or die "Can't close Cmd_subval.tmp: $!";
 118
 119 &file_main(*F);
 120 close F or die "Can't close: $!";
 121 &info_main;
 122
 123 &file_package(*F);
 124 close F or die "Can't close: $!";
 125 &info_package;
 126
 127 unlink 'Cmd_subval.tmp';
 128
 129 sub file_main {
 130         local(*F) = @_;
 131
 132         open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
 133         $i++;
 134         eof F ? print "not ok $i\n" : print "ok $i\n";
 135 }
 136
 137 sub info_main {
 138         local(*F);
 139
 140         open(F, 'Cmd_subval.tmp') || die "test: can't open: $!\n";
 141         $i++;
 142         eof F ? print "not ok $i\n" : print "ok $i\n";
 143         &iseof(*F);
 144         close F or die "Can't close: $!";
 145 }
 146
 147 sub iseof {
 148         local(*UNIQ) = @_;
 149
 150         $i++;
 151         eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n";
 152 }
 153
 154 {package foo;
 155
 156  sub main'file_package {
 157         local(*F) = @_;
 158
 159         open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
 160         $main'i++;
 161         eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
 162  }
 163
 164  sub main'info_package {
 165         local(*F);
 166
 167         open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
 168         $main'i++;
 169         eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
 170         &iseof(*F);
 171  }
 172
 173  sub iseof {
 174         local(*UNIQ) = @_;
 175
 176         $main'i++;
 177         eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
 178  }
 179 }
 180
 181 sub autov { $_[0] = 23 };
 182
 183 my $href = {};
 184 print keys %$href ? 'not ' : '', "ok 35\n";
 185 autov($href->{b});
 186 print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n";