home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-src.tgz / tar.out / fsf / perl / t / op / overload.t < prev    next >
Text File  |  1996-09-28  |  5KB  |  268 lines
  1. #!./perl
  2.  
  3. BEGIN { unshift @INC, './lib', '../lib';
  4.     require Config; import Config;
  5. }
  6.  
  7. package Oscalar;
  8. use overload ( 
  9.                 # Anonymous subroutines:
  10. '+'    =>    sub {new Oscalar $ {$_[0]}+$_[1]},
  11. '-'    =>    sub {new Oscalar
  12.                $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
  13. '<=>'    =>    sub {new Oscalar
  14.                $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
  15. 'cmp'    =>    sub {new Oscalar
  16.                $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
  17. '*'    =>    sub {new Oscalar ${$_[0]}*$_[1]},
  18. '/'    =>    sub {new Oscalar 
  19.                $_[2]? $_[1]/${$_[0]} :
  20.              ${$_[0]}/$_[1]},
  21. '%'    =>    sub {new Oscalar
  22.                $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
  23. '**'    =>    sub {new Oscalar
  24.                $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
  25.  
  26. qw(
  27. ""    stringify
  28. 0+    numify)            # Order of arguments unsignificant
  29. );
  30.  
  31. sub new {
  32.   my $foo = $_[1];
  33.   bless \$foo;
  34. }
  35.  
  36. sub stringify { "${$_[0]}" }
  37. sub numify { 0 + "${$_[0]}" }    # Not needed, additional overhead
  38.                 # comparing to direct compilation based on
  39.                 # stringify
  40.  
  41. package main;
  42.  
  43. $test = 0;
  44. $| = 1;
  45. print "1..",&last,"\n";
  46.  
  47. sub test {
  48.   $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0}
  49. }
  50.  
  51. $a = new Oscalar "087";
  52. $b= "$a";
  53.  
  54. # All test numbers in comments are off by 1.
  55. # So much for hard-wiring them in :-)
  56. test ($b eq $a);        # 2
  57. test ($b eq "087");        # 3
  58. test (ref $a eq "Oscalar");    # 4
  59. test ($a eq $a);        # 5
  60. test ($a eq "087");        # 6
  61.  
  62. $c = $a + 7;
  63.  
  64. test (ref $c eq "Oscalar");    # 7
  65. test (!($c eq $a));        # 8
  66. test ($c eq "94");        # 9
  67.  
  68. $b=$a;
  69.  
  70. test (ref $a eq "Oscalar");    # 10
  71.  
  72. $b++;
  73.  
  74. test (ref $b eq "Oscalar");    # 11
  75. test ( $a eq "087");        # 12
  76. test ( $b eq "88");        # 13
  77. test (ref $a eq "Oscalar");    # 14
  78.  
  79. $c=$b;
  80. $c-=$a;
  81.  
  82. test (ref $c eq "Oscalar");    # 15
  83. test ( $a eq "087");        # 16
  84. test ( $c eq "1");        # 17
  85. test (ref $a eq "Oscalar");    # 18
  86.  
  87. $b=1;
  88. $b+=$a;
  89.  
  90. test (ref $b eq "Oscalar");    # 19
  91. test ( $a eq "087");        # 20
  92. test ( $b eq "88");        # 21
  93. test (ref $a eq "Oscalar");    # 22
  94.  
  95. eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
  96.  
  97. $b=$a;
  98.  
  99. test (ref $a eq "Oscalar");    # 23
  100.  
  101. $b++;
  102.  
  103. test (ref $b eq "Oscalar");    # 24
  104. test ( $a eq "087");        # 25
  105. test ( $b eq "88");        # 26
  106. test (ref $a eq "Oscalar");    # 27
  107.  
  108. package Oscalar;
  109. $dummy=bless \$dummy;        # Now cache of method should be reloaded
  110. package main;
  111.  
  112. $b=$a;
  113. $b++;                
  114.  
  115. test (ref $b eq "Oscalar");    # 28
  116. test ( $a eq "087");        # 29
  117. test ( $b eq "88");        # 30
  118. test (ref $a eq "Oscalar");    # 31
  119.  
  120.  
  121. eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
  122.  
  123. $b=$a;
  124.  
  125. test (ref $a eq "Oscalar");    # 32
  126.  
  127. $b++;
  128.  
  129. test (ref $b eq "Oscalar");    # 33
  130. test ( $a eq "087");        # 34
  131. test ( $b eq "88");        # 35
  132. test (ref $a eq "Oscalar");    # 36
  133.  
  134. package Oscalar;
  135. $dummy=bless \$dummy;        # Now cache of method should be reloaded
  136. package main;
  137.  
  138. $b++;                
  139.  
  140. test (ref $b eq "Oscalar");    # 37
  141. test ( $a eq "087");        # 38
  142. test ( $b eq "90");        # 39
  143. test (ref $a eq "Oscalar");    # 40
  144.  
  145. $b=$a;
  146. $b++;
  147.  
  148. test (ref $b eq "Oscalar");    # 41
  149. test ( $a eq "087");        # 42
  150. test ( $b eq "89");        # 43
  151. test (ref $a eq "Oscalar");    # 44
  152.  
  153.  
  154. test ($b? 1:0);            # 45
  155.  
  156. eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; 
  157.                            package Oscalar;
  158.                            local $new=$ {$_[0]};
  159.                            bless \$new } ) ];
  160.  
  161. $b=new Oscalar "$a";
  162.  
  163. test (ref $b eq "Oscalar");    # 46
  164. test ( $a eq "087");        # 47
  165. test ( $b eq "087");        # 48
  166. test (ref $a eq "Oscalar");    # 49
  167.  
  168. $b++;
  169.  
  170. test (ref $b eq "Oscalar");    # 50
  171. test ( $a eq "087");        # 51
  172. test ( $b eq "89");        # 52
  173. test (ref $a eq "Oscalar");    # 53
  174. test ($copies == 0);        # 54
  175.  
  176. $b+=1;
  177.  
  178. test (ref $b eq "Oscalar");    # 55
  179. test ( $a eq "087");        # 56
  180. test ( $b eq "90");        # 57
  181. test (ref $a eq "Oscalar");    # 58
  182. test ($copies == 0);        # 59
  183.  
  184. $b=$a;
  185. $b+=1;
  186.  
  187. test (ref $b eq "Oscalar");    # 60
  188. test ( $a eq "087");        # 61
  189. test ( $b eq "88");        # 62
  190. test (ref $a eq "Oscalar");    # 63
  191. test ($copies == 0);        # 64
  192.  
  193. $b=$a;
  194. $b++;
  195.  
  196. test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n";    # 65
  197. test ( $a eq "087");        # 66
  198. test ( $b eq "89");        # 67
  199. test (ref $a eq "Oscalar");    # 68
  200. test ($copies == 1);        # 69
  201.  
  202. eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
  203.                            $_[0] } ) ];
  204. $c=new Oscalar;            # Cause rehash
  205.  
  206. $b=$a;
  207. $b+=1;
  208.  
  209. test (ref $b eq "Oscalar");    # 70
  210. test ( $a eq "087");        # 71
  211. test ( $b eq "90");        # 72
  212. test (ref $a eq "Oscalar");    # 73
  213. test ($copies == 2);        # 74
  214.  
  215. $b+=$b;
  216.  
  217. test (ref $b eq "Oscalar");    # 75
  218. test ( $b eq "360");        # 76
  219. test ($copies == 2);        # 77
  220. $b=-$b;
  221.  
  222. test (ref $b eq "Oscalar");    # 78
  223. test ( $b eq "-360");        # 79
  224. test ($copies == 2);        # 80
  225.  
  226. $b=abs($b);
  227.  
  228. test (ref $b eq "Oscalar");    # 81
  229. test ( $b eq "360");        # 82
  230. test ($copies == 2);        # 83
  231.  
  232. $b=abs($b);
  233.  
  234. test (ref $b eq "Oscalar");    # 84
  235. test ( $b eq "360");        # 85
  236. test ($copies == 2);        # 86
  237.  
  238. eval q[package Oscalar; 
  239.        use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
  240.                           : "_.${$_[0]}._" x $_[1])}) ];
  241.  
  242. $a=new Oscalar "yy";
  243. $a x= 3;
  244. test ($a eq "_.yy.__.yy.__.yy._"); # 87
  245.  
  246. eval q[package Oscalar; 
  247.        use overload ('.' => sub {new Oscalar ( $_[2] ? 
  248.                           "_.$_[1].__.$ {$_[0]}._"
  249.                           : "_.$ {$_[0]}.__.$_[1]._")}) ];
  250.  
  251. $a=new Oscalar "xx";
  252.  
  253. test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
  254.  
  255. # Here we test blessing to a package updates hash
  256.  
  257. eval "package Oscalar; no overload '.'";
  258.  
  259. test ("b${a}" eq "_.b.__.xx._"); # 89
  260. $x="1";
  261. bless \$x, Oscalar;
  262. test ("b${a}c" eq "bxxc");    # 90
  263. new Oscalar 1;
  264. test ("b${a}c" eq "bxxc");    # 91
  265.  
  266. # Last test is number 90.
  267. sub last {90}
  268.