home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / TEST / TESTMISC.SA < prev    next >
Text File  |  1995-02-14  |  5KB  |  191 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. class TEST_MISC is
  9.  
  10.     include TEST;
  11.  
  12.     attr attr_i,attr_j,attr_k,attr_z:INT;
  13.  
  14.     shared s1:INT;
  15.     shared s2:INT:=1;
  16.     shared s3:INT:=s2+1;
  17.  
  18.     const c1:INT:=0;
  19.     const c2:INT:=c1+1;
  20.  
  21.     create:SAME is return new; end;
  22.  
  23.     main is
  24.  
  25.     class_name("Misc");
  26.  
  27.     test("shareds and const init",""+s1+' '+s2+' '+s3+' '+c1+' '+c2,"0 1 2 0 1");
  28.  
  29.     i::=1;
  30.     j::=i+1;
  31.     k::=1+j;
  32.     kk:INT;
  33.         test("local vars",""+i+' '+j+' '+k+' '+kk,"1 2 3 0");
  34.  
  35.         outp:STR:="";
  36.     loop outp:=outp+1.upto!(10)+' '; end;
  37.     test("simple iter",outp,"1 2 3 4 5 6 7 8 9 10 ");
  38.  
  39.         attr_i:=1;
  40.     attr_j:=attr_i+1;
  41.     attr_k:=1+attr_j;
  42.     test("simple attr",""+attr_i+' '+attr_j+' '+attr_k+' '+attr_z,"1 2 3 0");
  43.  
  44.         a:ARRAY{INT}:=|9,8,7,6,5,4,3,2,1,0|;
  45.         loop i:=0.upto!(4);
  46.             -- reverse order
  47.             temp::=a[i];
  48.             a[i]:=a[9-i];
  49.             a[9-i]:=temp;
  50.         end;
  51.     outp:="";
  52.         loop i:=0.upto!(9); outp:=outp+a[i]+' '; end;
  53.     test("Simple array",outp,"0 1 2 3 4 5 6 7 8 9 ");
  54.  
  55.     outp:="";
  56.     b:$A:=#B;
  57.     typecase b when B then outp:=outp+"first "; end;
  58.     typecase b when $A then outp:=outp+"second "; end;
  59.     typecase b when C then else outp:=outp+"third"; end;
  60.     test("simple typecase",outp,"first second third");
  61.  
  62.     outp:="";
  63.     loop outp:=outp+primes!+' '; end;
  64.     test("complex iter",outp,"2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 ");
  65.  
  66.     c:$A:=#C;
  67.     test("routine dispatch",b.str+' '+c.str+' '+b.op(2,3)+' '+c.op(2,3),
  68.                   "first second 5 6");
  69.     --outp:="";
  70.     --b2:$AA:=#B;
  71.     --c2:$AA:=#C;
  72.     -- loop outp:=outp+b2.it!+' '+c2.it!+' '; end;
  73.     --test("iter dispatch",outp,"B1 C1 B2 C2 ");
  74.  
  75.     test("basic arith",(2.0+3.0).str+' '+(2.0*3.0).str,"5 6");
  76.  
  77.         x::=#CPX(1.0,2.0);
  78.     x:=x.re(4.0);
  79.         test("cpx",x.str+' '+(-x).str+' '+x.abs,"4+2i -4-2i 4.47214");
  80.  
  81.     z,y:D;
  82.     z:=y;
  83.     loop
  84.         i:=0.upto!(3); 
  85.         z:=z.aset(i,i.flt);
  86.     end;
  87.     outp:="";
  88.     loop outp:=outp+y[0.upto!(3)]+' '; end;
  89.     loop outp:=outp+z[0.upto!(3)]+' '; end;
  90.     int1::=123456;
  91.     int2::=654321;
  92.     loop ii::=0.upto!(31); int2:=int2.aset(ii,int1[ii]); end;
  93.     outp:=outp+int2;
  94.     test("value aset/aget",outp,"0 0 0 0 0 1 2 3 123456");
  95.  
  96.         aa,bb:D;
  97.     aaa:$A;
  98.     aaa:=aa.x(2).y(3);
  99.     typecase aaa when D then bb:=aaa; end;
  100.     test("boxing",aaa.str+' '+bb.x+' '+bb.y+' '+aaa.op(2,3),"bing 2 3 7");
  101.  
  102.     --
  103.     outp:="";
  104.     outp:= SYS::str_for_tp(SYS::tp(b)) + ' '
  105.          + SYS::str_for_tp(SYS::tp(c)) + ' '
  106.          + SYS::str_for_tp(SYS::tp(aaa)) + ' '
  107.          + SYS::ob_eq(b,b) + ' ' 
  108.          + SYS::ob_eq(b,c) + ' '
  109.          + SYS::ob_eq(aa,aa) + ' '
  110.          + SYS::ob_eq(aa,bb) + ' ';
  111.     bb:=aa;
  112.     outp:=outp + SYS::ob_eq(aa,bb);
  113.     test("SYS class",outp,"B C D true false true false true");
  114.  
  115.         --
  116.         --#OUT + "Test of invariant, should output \"called\":\n";
  117.     --e::=#E;
  118.  
  119.     d2,d3:D;
  120.     d3:=d3.x(1);
  121.         test("void test",""+void(d2)+' '+void(d3),"true false");
  122.  
  123.         br1:ROUT{INT,STR}:STR:=#ROUT(self.foo(_,2,_));
  124.         br2:ROUT:INT:=#ROUT(self.foo2);
  125.         test("bound routines",br1.call(1,br2.call.str),"1 2 3");
  126.  
  127.         finish;
  128.  
  129.     end;
  130.  
  131.     foo(x,y:INT,s:STR):STR is return "" + x + " " + y + " " + s end;
  132.  
  133.     foo2:INT is return 3 end;
  134.  
  135.     sieve!(aprime:INT!):BOOL is
  136.     d::=aprime;
  137.     yield true;
  138.     loop
  139.         if d.evenly_divides(aprime) then yield false;
  140.         else yield sieve!(aprime);
  141.         end;
  142.     end;
  143.     end;
  144.  
  145.     primes!:INT is
  146.     loop
  147.         v::=2.upto!(50);
  148.         if sieve!(v) then yield v; end;
  149.     end;
  150.     end;
  151.  
  152. end;
  153.  
  154. type $A is
  155.     str:STR;
  156.     op(a,b:INT):INT;
  157. end;
  158.  
  159. type $AA is
  160.     it!:STR;
  161. end;
  162.  
  163. class B<$A,$AA is
  164.     create:SAME is return new; end;
  165.     str:STR is return "first"; end;
  166.     op(a,b:INT):INT is return a+b; end;
  167.     it!:STR is yield "B1"; yield "B2"; end;
  168. end;
  169.  
  170. class C<$A,$AA is
  171.     create:SAME is return new; end;
  172.     str:STR is return "second"; end;
  173.     op(a,b:INT):INT is return a*b; end;
  174.     it!:STR is yield "C1"; yield "C2"; end;
  175. end;
  176.  
  177. value class D < $A is
  178.     include AVAL{FLT} asize->;
  179.     const asize:INT:=4;
  180.  
  181.     attr x,y:INT;
  182.  
  183.     str:STR is return "bing"; end;
  184.     op(a,b:INT):INT is return 2*a+b; end;
  185. end;
  186.  
  187. class E is
  188.     create:SAME is return new; end;
  189.     invariant:BOOL is #OUT + "called.\n\n"; return true; end;
  190. end;
  191.