home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / perl / os2perl / subval.t < prev    next >
Text File  |  1991-04-12  |  4KB  |  180 lines
  1. #!./perl
  2.  
  3. # $Header: subval.t,v 4.0 91/03/20 01:49:40 lwall Locked $
  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..34\n";
  37.  
  38. if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
  39. if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
  40. if (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
  41. if (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
  42.  
  43. if (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
  44. if (do foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
  45. if (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
  46. if (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
  47.  
  48. if (do foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
  49. if (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
  50. if (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
  51. if (do 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.     local($arg) = @_;
  57.     local($foo);
  58.     $level++;
  59.     if ($arg <= 2) {
  60.     $foo = 1;
  61.     }
  62.     else {
  63.     $foo = do fib($arg-1) + do 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 (do 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\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;
  118.  
  119. &file_main(*F);
  120. close F;
  121. &info_main;
  122.  
  123. &file_package(*F);
  124. close F;
  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;
  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.