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 >
Wrap
Text File
|
1995-02-14
|
5KB
|
191 lines
-- Copyright (C) International Computer Science Institute, 1994. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
class TEST_MISC is
include TEST;
attr attr_i,attr_j,attr_k,attr_z:INT;
shared s1:INT;
shared s2:INT:=1;
shared s3:INT:=s2+1;
const c1:INT:=0;
const c2:INT:=c1+1;
create:SAME is return new; end;
main is
class_name("Misc");
test("shareds and const init",""+s1+' '+s2+' '+s3+' '+c1+' '+c2,"0 1 2 0 1");
i::=1;
j::=i+1;
k::=1+j;
kk:INT;
test("local vars",""+i+' '+j+' '+k+' '+kk,"1 2 3 0");
outp:STR:="";
loop outp:=outp+1.upto!(10)+' '; end;
test("simple iter",outp,"1 2 3 4 5 6 7 8 9 10 ");
attr_i:=1;
attr_j:=attr_i+1;
attr_k:=1+attr_j;
test("simple attr",""+attr_i+' '+attr_j+' '+attr_k+' '+attr_z,"1 2 3 0");
a:ARRAY{INT}:=|9,8,7,6,5,4,3,2,1,0|;
loop i:=0.upto!(4);
-- reverse order
temp::=a[i];
a[i]:=a[9-i];
a[9-i]:=temp;
end;
outp:="";
loop i:=0.upto!(9); outp:=outp+a[i]+' '; end;
test("Simple array",outp,"0 1 2 3 4 5 6 7 8 9 ");
outp:="";
b:$A:=#B;
typecase b when B then outp:=outp+"first "; end;
typecase b when $A then outp:=outp+"second "; end;
typecase b when C then else outp:=outp+"third"; end;
test("simple typecase",outp,"first second third");
outp:="";
loop outp:=outp+primes!+' '; end;
test("complex iter",outp,"2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 ");
c:$A:=#C;
test("routine dispatch",b.str+' '+c.str+' '+b.op(2,3)+' '+c.op(2,3),
"first second 5 6");
--outp:="";
--b2:$AA:=#B;
--c2:$AA:=#C;
-- loop outp:=outp+b2.it!+' '+c2.it!+' '; end;
--test("iter dispatch",outp,"B1 C1 B2 C2 ");
test("basic arith",(2.0+3.0).str+' '+(2.0*3.0).str,"5 6");
x::=#CPX(1.0,2.0);
x:=x.re(4.0);
test("cpx",x.str+' '+(-x).str+' '+x.abs,"4+2i -4-2i 4.47214");
z,y:D;
z:=y;
loop
i:=0.upto!(3);
z:=z.aset(i,i.flt);
end;
outp:="";
loop outp:=outp+y[0.upto!(3)]+' '; end;
loop outp:=outp+z[0.upto!(3)]+' '; end;
int1::=123456;
int2::=654321;
loop ii::=0.upto!(31); int2:=int2.aset(ii,int1[ii]); end;
outp:=outp+int2;
test("value aset/aget",outp,"0 0 0 0 0 1 2 3 123456");
aa,bb:D;
aaa:$A;
aaa:=aa.x(2).y(3);
typecase aaa when D then bb:=aaa; end;
test("boxing",aaa.str+' '+bb.x+' '+bb.y+' '+aaa.op(2,3),"bing 2 3 7");
--
outp:="";
outp:= SYS::str_for_tp(SYS::tp(b)) + ' '
+ SYS::str_for_tp(SYS::tp(c)) + ' '
+ SYS::str_for_tp(SYS::tp(aaa)) + ' '
+ SYS::ob_eq(b,b) + ' '
+ SYS::ob_eq(b,c) + ' '
+ SYS::ob_eq(aa,aa) + ' '
+ SYS::ob_eq(aa,bb) + ' ';
bb:=aa;
outp:=outp + SYS::ob_eq(aa,bb);
test("SYS class",outp,"B C D true false true false true");
--
--#OUT + "Test of invariant, should output \"called\":\n";
--e::=#E;
d2,d3:D;
d3:=d3.x(1);
test("void test",""+void(d2)+' '+void(d3),"true false");
br1:ROUT{INT,STR}:STR:=#ROUT(self.foo(_,2,_));
br2:ROUT:INT:=#ROUT(self.foo2);
test("bound routines",br1.call(1,br2.call.str),"1 2 3");
finish;
end;
foo(x,y:INT,s:STR):STR is return "" + x + " " + y + " " + s end;
foo2:INT is return 3 end;
sieve!(aprime:INT!):BOOL is
d::=aprime;
yield true;
loop
if d.evenly_divides(aprime) then yield false;
else yield sieve!(aprime);
end;
end;
end;
primes!:INT is
loop
v::=2.upto!(50);
if sieve!(v) then yield v; end;
end;
end;
end;
type $A is
str:STR;
op(a,b:INT):INT;
end;
type $AA is
it!:STR;
end;
class B<$A,$AA is
create:SAME is return new; end;
str:STR is return "first"; end;
op(a,b:INT):INT is return a+b; end;
it!:STR is yield "B1"; yield "B2"; end;
end;
class C<$A,$AA is
create:SAME is return new; end;
str:STR is return "second"; end;
op(a,b:INT):INT is return a*b; end;
it!:STR is yield "C1"; yield "C2"; end;
end;
value class D < $A is
include AVAL{FLT} asize->;
const asize:INT:=4;
attr x,y:INT;
str:STR is return "bing"; end;
op(a,b:INT):INT is return 2*a+b; end;
end;
class E is
create:SAME is return new; end;
invariant:BOOL is #OUT + "called.\n\n"; return true; end;
end;