home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / perl / os2perl / s.t < prev    next >
Text File  |  1991-04-12  |  5KB  |  180 lines
  1. #!./perl
  2.  
  3. # $Header: s.t,v 4.0 91/03/20 01:54:30 lwall Locked $
  4.  
  5. print "1..51\n";
  6.  
  7. $x = 'foo';
  8. $_ = "x";
  9. s/x/\$x/;
  10. print "#1\t:$_: eq :\$x:\n";
  11. if ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
  12.  
  13. $_ = "x";
  14. s/x/$x/;
  15. print "#2\t:$_: eq :foo:\n";
  16. if ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
  17.  
  18. $_ = "x";
  19. s/x/\$x $x/;
  20. print "#3\t:$_: eq :\$x foo:\n";
  21. if ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
  22.  
  23. $b = 'cd';
  24. ($a = 'abcdef') =~ s'(b${b}e)'\n$1';
  25. print "#4\t:$1: eq :bcde:\n";
  26. print "#4\t:$a: eq :a\\n\$1f:\n";
  27. if ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
  28.  
  29. $a = 'abacada';
  30. if (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
  31.     {print "ok 5\n";} else {print "not ok 5\n";}
  32.  
  33. if (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
  34.     {print "ok 6\n";} else {print "not ok 6 $a\n";}
  35.  
  36. if (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
  37.     {print "ok 7\n";} else {print "not ok 7 $a\n";}
  38.  
  39. $_ = 'ABACADA';
  40. if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";}
  41.  
  42. $_ = '\\' x 4;
  43. if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
  44. s/\\/\\\\/g;
  45. if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10 $_\n";}
  46.  
  47. $_ = '\/' x 4;
  48. if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
  49. s/\//\/\//g;
  50. if ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
  51. if (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
  52.  
  53. $_ = 'aaaXXXXbbb';
  54. s/^a//;
  55. print $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n";
  56.  
  57. $_ = 'aaaXXXXbbb';
  58. s/a//;
  59. print $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n";
  60.  
  61. $_ = 'aaaXXXXbbb';
  62. s/^a/b/;
  63. print $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n";
  64.  
  65. $_ = 'aaaXXXXbbb';
  66. s/a/b/;
  67. print $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n";
  68.  
  69. $_ = 'aaaXXXXbbb';
  70. s/aa//;
  71. print $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n";
  72.  
  73. $_ = 'aaaXXXXbbb';
  74. s/aa/b/;
  75. print $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n";
  76.  
  77. $_ = 'aaaXXXXbbb';
  78. s/b$//;
  79. print $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n";
  80.  
  81. $_ = 'aaaXXXXbbb';
  82. s/b//;
  83. print $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n";
  84.  
  85. $_ = 'aaaXXXXbbb';
  86. s/bb//;
  87. print $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n";
  88.  
  89. $_ = 'aaaXXXXbbb';
  90. s/aX/y/;
  91. print $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n";
  92.  
  93. $_ = 'aaaXXXXbbb';
  94. s/Xb/z/;
  95. print $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n";
  96.  
  97. $_ = 'aaaXXXXbbb';
  98. s/aaX.*Xbb//;
  99. print $_ eq 'ab' ? "ok 25\n" : "not ok 25\n";
  100.  
  101. $_ = 'aaaXXXXbbb';
  102. s/bb/x/;
  103. print $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n";
  104.  
  105. # now for some unoptimized versions of the same.
  106.  
  107. $_ = 'aaaXXXXbbb';
  108. $x ne $x || s/^a//;
  109. print $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n";
  110.  
  111. $_ = 'aaaXXXXbbb';
  112. $x ne $x || s/a//;
  113. print $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n";
  114.  
  115. $_ = 'aaaXXXXbbb';
  116. $x ne $x || s/^a/b/;
  117. print $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n";
  118.  
  119. $_ = 'aaaXXXXbbb';
  120. $x ne $x || s/a/b/;
  121. print $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n";
  122.  
  123. $_ = 'aaaXXXXbbb';
  124. $x ne $x || s/aa//;
  125. print $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n";
  126.  
  127. $_ = 'aaaXXXXbbb';
  128. $x ne $x || s/aa/b/;
  129. print $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n";
  130.  
  131. $_ = 'aaaXXXXbbb';
  132. $x ne $x || s/b$//;
  133. print $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n";
  134.  
  135. $_ = 'aaaXXXXbbb';
  136. $x ne $x || s/b//;
  137. print $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n";
  138.  
  139. $_ = 'aaaXXXXbbb';
  140. $x ne $x || s/bb//;
  141. print $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n";
  142.  
  143. $_ = 'aaaXXXXbbb';
  144. $x ne $x || s/aX/y/;
  145. print $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n";
  146.  
  147. $_ = 'aaaXXXXbbb';
  148. $x ne $x || s/Xb/z/;
  149. print $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n";
  150.  
  151. $_ = 'aaaXXXXbbb';
  152. $x ne $x || s/aaX.*Xbb//;
  153. print $_ eq 'ab' ? "ok 38\n" : "not ok 38\n";
  154.  
  155. $_ = 'aaaXXXXbbb';
  156. $x ne $x || s/bb/x/;
  157. print $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
  158.  
  159. $_ = 'abc123xyz';
  160. s/\d+/$&*2/e;              # yields 'abc246xyz'
  161. print $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
  162. s/\d+/sprintf("%5d",$&)/e; # yields 'abc  246xyz'
  163. print $_ eq 'abc  246xyz' ? "ok 41\n" : "not ok 41\n";
  164. s/\w/$& x 2/eg;            # yields 'aabbcc  224466xxyyzz'
  165. print $_ eq 'aabbcc  224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
  166.  
  167. $_ = "aaaaa";
  168. print y/a/b/ == 5 ? "ok 43\n" : "not ok 43\n";
  169. print y/a/b/ == 0 ? "ok 44\n" : "not ok 44\n";
  170. print y/b// == 5 ? "ok 45\n" : "not ok 45\n";
  171. print y/b/c/s == 5 ? "ok 46\n" : "not ok 46\n";
  172. print y/c// == 1 ? "ok 47\n" : "not ok 47\n";
  173. print y/c//d == 1 ? "ok 48\n" : "not ok 48\n";
  174. print $_ eq "" ? "ok 49\n" : "not ok 49\n";
  175.  
  176. $_ = "Now is the %#*! time for all good men...";
  177. print (($x=(y/a-zA-Z //cd)) == 7 ? "ok 50\n" : "not ok 50\n");
  178. print y/ / /s == 8 ? "ok 51\n" : "not ok 51\n";
  179.  
  180.