implement Exec; include "sys.m";include "Exec.m";include "external_module.m"; include "math.m"; m : Math;sys : Sys; TEST_FAILED : exception; init(args: list of string){ a := "foobar!"; sys = load Sys Sys->PATH; m = load Math Math->PATH; big_val := big 16r12345; sys->print("Hello, %s %o %d %x %bd %f\n%s%%%% %H\n\n", "world!", 8, 10, 16, big_val, 0.1, "------------------\n", a); while (args != nil) { arg := hd args; sys->print("-- %s --\n", arg); args = tl args; } test_floating_point(); test_poly(); test_function_refs(); test_alt(); test_channel(); test_spawn(); test_exceptions(); test_case(); test_discriminated_union(); test_external_module(); test_fixed_point(); test_exponent(); test_string(); test_array(); test_list(); test_branch(); test_for_loop_function_call();} test_floating_point(){ sys->print("test_floating_point()\n"); all_flags : con (Math->INVAL | Math->ZDIV | Math->OVFL | Math->UNFL | Math->INEX) | Math->RND_MASK; R : real; m->FPcontrol(Math->RND_NR, all_flags); R = m->rint(12.1); if (R >= 12.1) raise TEST_FAILED(); m->FPcontrol(Math->RND_NINF, all_flags); R = m->rint(13.1); if (R >= 13.1) raise TEST_FAILED(); R = m->rint(13.9); if (R >= 13.9) raise TEST_FAILED(); m->FPcontrol(Math->RND_PINF, all_flags); R = m->rint(14.1); if (R <= 14.1) raise TEST_FAILED(); R = m->rint(14.9); if (R <= 14.9) raise TEST_FAILED(); m->FPcontrol(Math->RND_Z, all_flags); R = m->rint(-14.1); if (R <= -14.1) raise TEST_FAILED(); R = m->rint(-14.9); if (R <= -14.9) raise TEST_FAILED(); # Reset exception flags m->FPstatus(0, all_flags); status := m->getFPstatus(); if (status & Math->ZDIV) raise TEST_FAILED(); if (status != 0) raise TEST_FAILED(); R = 12. / real status; status = m->getFPstatus(); if (!(status & Math->ZDIV)) raise TEST_FAILED();} reverse[T](l: list of T): list of T{ rl: list of T; for(; l != nil; l = tl l) rl = hd l :: rl; return rl;} equal[T](l, r: list of T): int{ l_v, r_v : T; l_v = hd l; r_v = hd r; l = tl l; r = tl r; while (l_v == r_v) { l_v = hd l; r_v = hd r; l = tl l; r = tl r; if (l == nil || r == nil) break; } return l == r;} test_poly(){ sys->print("test_poly()\n"); l1 := list of {"a", "b", "c"}; l2 := reverse(l1); if (!equal(l1, reverse(l2)) != 0) raise TEST_FAILED();} str_cmp(s1: string, s2: string): int{ if (s1 < s2) return -1; else if (s1 > s2) return 1; return 0;} test_function_refs(){ sys->print("test_function_refs()\n"); f : ref fn(s1: string, s2: string): int; f = str_cmp; s1 := "abcdefg"; s2 := "ABCDEFG"; if (f(s1, s2) != 1) raise TEST_FAILED();} test_alt(){ sys->print("test_alt()\n"); int_chan_10 := chan of int; int_chan_20 := chan of int; int_chan_done := chan of int; spawn alt1(int_chan_10, int_chan_20, int_chan_done); d : int = 0; while (d == 0) { alt { r1 := <- int_chan_10 => if (r1 != 10) raise TEST_FAILED(); r2 := <- int_chan_20 => if (r2 != 20) raise TEST_FAILED(); d = <- int_chan_done => ; } } spawn alt2(int_chan_10, int_chan_20, int_chan_done); unused : int = 0; int_chan_unused1 := chan of int; int_chan_unused2 := chan of int; d = 0; while(d == 0) { alt { unused =<- int_chan_unused1 => raise TEST_FAILED(); int_chan_unused2 <-= unused => raise TEST_FAILED(); * => ; } alt { int_chan_10 <-= 10 => ; int_chan_20 <-= 20 => ; d = <- int_chan_done => ; } alt { unused =<- int_chan_unused1 => raise TEST_FAILED(); int_chan_unused2 <-= unused => raise TEST_FAILED(); * => ; } }} alt1(ten : chan of int, twenty : chan of int, done : chan of int){ twenty <-= 20; ten <-= 10; ten <-= 10; twenty <-= 20; done <-= 1;} alt2(ten : chan of int, twenty : chan of int, done : chan of int){ v : int; v =<- twenty; if (v != 20) raise TEST_FAILED(); v =<- ten; if (v != 10) raise TEST_FAILED(); v =<- twenty; if (v != 20) raise TEST_FAILED(); v =<- twenty; if (v != 20) raise TEST_FAILED(); v =<- ten; if (v != 10) raise TEST_FAILED(); v =<- ten; if (v != 10) raise TEST_FAILED(); done <-= 1;} test_channel(){ sys->print("test_channel()\n"); test_channel_int(nil); test_channel_int_buffered(nil, nil); test_channel_adt(nil); test_channel_adt_buffered(nil, nil); test_channel_ref_adt(nil); test_channel_ref_adt_buffered(nil, nil);} test_channel_int(c : chan of int){ if (c == nil) { c_l := chan of int; spawn test_channel_int(c_l); m := <- c_l; if (m != 10) raise TEST_FAILED(); c_l <-= 20; } else { c <-= 10; m := <- c; if (m != 20) raise TEST_FAILED(); }} test_channel_int_buffered(c : chan of int, r : chan of int){ if (c == nil) { c_l := chan[3] of int; r_l := chan of int; spawn test_channel_int_buffered(c_l, r_l); m := <- c_l; if (m != 10) raise TEST_FAILED(); m += <- c_l; if (m != 20) raise TEST_FAILED(); m += <- c_l; if (m != 30) raise TEST_FAILED(); m += <- c_l; if (m != 40) raise TEST_FAILED(); m += <- c_l; if (m != 50) raise TEST_FAILED(); r_l <-= m; } else { c <-= 10; c <-= 10; c <-= 10; c <-= 10; c <-= 10; m := <- r; if (m != 50) raise TEST_FAILED(); }} ChannelAdt : adt{ s : string; d : real;}; test_channel_adt(c : chan of ChannelAdt){ if (c == nil) { c_l := chan of ChannelAdt; spawn test_channel_adt(c_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); c_l <-= ("to", 2.0); } else { c <-= ("from", 1.0); m := <- c; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); }} test_channel_adt_buffered(c : chan of ChannelAdt, r : chan of ChannelAdt){ if (c == nil) { c_l := chan[1] of ChannelAdt; r_l := chan of ChannelAdt; spawn test_channel_adt_buffered(c_l, r_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); r_l <-= ("to", 2.0); } else { c <-= ("from", 1.0); c <-= ("from", 1.0); c <-= ("from", 1.0); m := <- r; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); }} test_channel_ref_adt(c : chan of ref ChannelAdt){ if (c == nil) { c_l := chan of ref ChannelAdt; spawn test_channel_ref_adt(c_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); c_l <-= ref ("to", 2.0); } else { c <-= ref ("from", 1.0); m := <- c; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); }} test_channel_ref_adt_buffered(c : chan of ref ChannelAdt, r : chan of ref ChannelAdt){ if (c == nil) { c_l := chan[1] of ref ChannelAdt; r_l := chan of ref ChannelAdt; spawn test_channel_ref_adt_buffered(c_l, r_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); r_l <-= ref ("to", 2.0); } else { c <-= ref ("from", 1.0); c <-= ref ("from", 1.0); c <-= ref ("from", 1.0); m := <- r; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); }} test_spawn(){ sys->print("test_spawn()\n"); spawn th1();} th1(){ a := 9; b := 11; c := a + b; if (c != 20) raise TEST_FAILED();} TESTEXCEPTION : exception(int, int); test_exceptions(){ sys->print("test_exceptions()\n"); { raise TESTEXCEPTION(5,10); } exception e { TESTEXCEPTION => (a,b) := e; if (a != 5 || b != 10) raise TEST_FAILED(); * => raise TEST_FAILED(); } { raise "bad time"; } exception e { "bad time" => ; * => raise TEST_FAILED(); } s := 0; { raise_exception_1(0); } exception e { TESTEXCEPTION => s = 1; * => ; } if (s != 1) raise TEST_FAILED(); s = 0; { raise_exception_1(1); } exception e { "exception string" => s = 1; * => ; } if (s != 1) raise TEST_FAILED(); s = 0; { raise_exception_n(7, "a5"); } exception e { TESTEXCEPTION => (a,b) := e; if (a != 0) raise TEST_FAILED(); s = 1; * => ; } if (s != 1) raise TEST_FAILED();} raise_exception_1(v : int){ { raise_exception_2(v); } exception e { "do not catch" => raise TEST_FAILED();Lines 1–500 of 1173. Load more
implement Exec; include "sys.m"; include "Exec.m"; include "external_module.m"; include "math.m"; m : Math; sys : Sys; TEST_FAILED : exception; init(args: list of string) { a := "foobar!"; sys = load Sys Sys->PATH; m = load Math Math->PATH; big_val := big 16r12345; sys->print("Hello, %s %o %d %x %bd %f\n%s%%%% %H\n\n", "world!", 8, 10, 16, big_val, 0.1, "------------------\n", a); while (args != nil) { arg := hd args; sys->print("-- %s --\n", arg); args = tl args; } test_floating_point(); test_poly(); test_function_refs(); test_alt(); test_channel(); test_spawn(); test_exceptions(); test_case(); test_discriminated_union(); test_external_module(); test_fixed_point(); test_exponent(); test_string(); test_array(); test_list(); test_branch(); test_for_loop_function_call(); } test_floating_point() { sys->print("test_floating_point()\n"); all_flags : con (Math->INVAL | Math->ZDIV | Math->OVFL | Math->UNFL | Math->INEX) | Math->RND_MASK; R : real; m->FPcontrol(Math->RND_NR, all_flags); R = m->rint(12.1); if (R >= 12.1) raise TEST_FAILED(); m->FPcontrol(Math->RND_NINF, all_flags); R = m->rint(13.1); if (R >= 13.1) raise TEST_FAILED(); R = m->rint(13.9); if (R >= 13.9) raise TEST_FAILED(); m->FPcontrol(Math->RND_PINF, all_flags); R = m->rint(14.1); if (R <= 14.1) raise TEST_FAILED(); R = m->rint(14.9); if (R <= 14.9) raise TEST_FAILED(); m->FPcontrol(Math->RND_Z, all_flags); R = m->rint(-14.1); if (R <= -14.1) raise TEST_FAILED(); R = m->rint(-14.9); if (R <= -14.9) raise TEST_FAILED(); # Reset exception flags m->FPstatus(0, all_flags); status := m->getFPstatus(); if (status & Math->ZDIV) raise TEST_FAILED(); if (status != 0) raise TEST_FAILED(); R = 12. / real status; status = m->getFPstatus(); if (!(status & Math->ZDIV)) raise TEST_FAILED(); } reverse[T](l: list of T): list of T { rl: list of T; for(; l != nil; l = tl l) rl = hd l :: rl; return rl; } equal[T](l, r: list of T): int { l_v, r_v : T; l_v = hd l; r_v = hd r; l = tl l; r = tl r; while (l_v == r_v) { l_v = hd l; r_v = hd r; l = tl l; r = tl r; if (l == nil || r == nil) break; } return l == r; } test_poly() { sys->print("test_poly()\n"); l1 := list of {"a", "b", "c"}; l2 := reverse(l1); if (!equal(l1, reverse(l2)) != 0) raise TEST_FAILED(); } str_cmp(s1: string, s2: string): int { if (s1 < s2) return -1; else if (s1 > s2) return 1; return 0; } test_function_refs() { sys->print("test_function_refs()\n"); f : ref fn(s1: string, s2: string): int; f = str_cmp; s1 := "abcdefg"; s2 := "ABCDEFG"; if (f(s1, s2) != 1) raise TEST_FAILED(); } test_alt() { sys->print("test_alt()\n"); int_chan_10 := chan of int; int_chan_20 := chan of int; int_chan_done := chan of int; spawn alt1(int_chan_10, int_chan_20, int_chan_done); d : int = 0; while (d == 0) { alt { r1 := <- int_chan_10 => if (r1 != 10) raise TEST_FAILED(); r2 := <- int_chan_20 => if (r2 != 20) raise TEST_FAILED(); d = <- int_chan_done => ; } } spawn alt2(int_chan_10, int_chan_20, int_chan_done); unused : int = 0; int_chan_unused1 := chan of int; int_chan_unused2 := chan of int; d = 0; while(d == 0) { alt { unused =<- int_chan_unused1 => raise TEST_FAILED(); int_chan_unused2 <-= unused => raise TEST_FAILED(); * => ; } alt { int_chan_10 <-= 10 => ; int_chan_20 <-= 20 => ; d = <- int_chan_done => ; } alt { unused =<- int_chan_unused1 => raise TEST_FAILED(); int_chan_unused2 <-= unused => raise TEST_FAILED(); * => ; } } } alt1(ten : chan of int, twenty : chan of int, done : chan of int) { twenty <-= 20; ten <-= 10; ten <-= 10; twenty <-= 20; done <-= 1; } alt2(ten : chan of int, twenty : chan of int, done : chan of int) { v : int; v =<- twenty; if (v != 20) raise TEST_FAILED(); v =<- ten; if (v != 10) raise TEST_FAILED(); v =<- twenty; if (v != 20) raise TEST_FAILED(); v =<- twenty; if (v != 20) raise TEST_FAILED(); v =<- ten; if (v != 10) raise TEST_FAILED(); v =<- ten; if (v != 10) raise TEST_FAILED(); done <-= 1; } test_channel() { sys->print("test_channel()\n"); test_channel_int(nil); test_channel_int_buffered(nil, nil); test_channel_adt(nil); test_channel_adt_buffered(nil, nil); test_channel_ref_adt(nil); test_channel_ref_adt_buffered(nil, nil); } test_channel_int(c : chan of int) { if (c == nil) { c_l := chan of int; spawn test_channel_int(c_l); m := <- c_l; if (m != 10) raise TEST_FAILED(); c_l <-= 20; } else { c <-= 10; m := <- c; if (m != 20) raise TEST_FAILED(); } } test_channel_int_buffered(c : chan of int, r : chan of int) { if (c == nil) { c_l := chan[3] of int; r_l := chan of int; spawn test_channel_int_buffered(c_l, r_l); m := <- c_l; if (m != 10) raise TEST_FAILED(); m += <- c_l; if (m != 20) raise TEST_FAILED(); m += <- c_l; if (m != 30) raise TEST_FAILED(); m += <- c_l; if (m != 40) raise TEST_FAILED(); m += <- c_l; if (m != 50) raise TEST_FAILED(); r_l <-= m; } else { c <-= 10; c <-= 10; c <-= 10; c <-= 10; c <-= 10; m := <- r; if (m != 50) raise TEST_FAILED(); } } ChannelAdt : adt { s : string; d : real; }; test_channel_adt(c : chan of ChannelAdt) { if (c == nil) { c_l := chan of ChannelAdt; spawn test_channel_adt(c_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); c_l <-= ("to", 2.0); } else { c <-= ("from", 1.0); m := <- c; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); } } test_channel_adt_buffered(c : chan of ChannelAdt, r : chan of ChannelAdt) { if (c == nil) { c_l := chan[1] of ChannelAdt; r_l := chan of ChannelAdt; spawn test_channel_adt_buffered(c_l, r_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); r_l <-= ("to", 2.0); } else { c <-= ("from", 1.0); c <-= ("from", 1.0); c <-= ("from", 1.0); m := <- r; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); } } test_channel_ref_adt(c : chan of ref ChannelAdt) { if (c == nil) { c_l := chan of ref ChannelAdt; spawn test_channel_ref_adt(c_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); c_l <-= ref ("to", 2.0); } else { c <-= ref ("from", 1.0); m := <- c; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); } } test_channel_ref_adt_buffered(c : chan of ref ChannelAdt, r : chan of ref ChannelAdt) { if (c == nil) { c_l := chan[1] of ref ChannelAdt; r_l := chan of ref ChannelAdt; spawn test_channel_ref_adt_buffered(c_l, r_l); m := <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); m = <- c_l; if (m.s != "from") raise TEST_FAILED(); if (m.d != 1.0) raise TEST_FAILED(); r_l <-= ref ("to", 2.0); } else { c <-= ref ("from", 1.0); c <-= ref ("from", 1.0); c <-= ref ("from", 1.0); m := <- r; if (m.s != "to") raise TEST_FAILED(); if (m.d != 2.0) raise TEST_FAILED(); } } test_spawn() { sys->print("test_spawn()\n"); spawn th1(); } th1() { a := 9; b := 11; c := a + b; if (c != 20) raise TEST_FAILED(); } TESTEXCEPTION : exception(int, int); test_exceptions() { sys->print("test_exceptions()\n"); { raise TESTEXCEPTION(5,10); } exception e { TESTEXCEPTION => (a,b) := e; if (a != 5 || b != 10) raise TEST_FAILED(); * => raise TEST_FAILED(); } { raise "bad time"; } exception e { "bad time" => ; * => raise TEST_FAILED(); } s := 0; { raise_exception_1(0); } exception e { TESTEXCEPTION => s = 1; * => ; } if (s != 1) raise TEST_FAILED(); s = 0; { raise_exception_1(1); } exception e { "exception string" => s = 1; * => ; } if (s != 1) raise TEST_FAILED(); s = 0; { raise_exception_n(7, "a5"); } exception e { TESTEXCEPTION => (a,b) := e; if (a != 0) raise TEST_FAILED(); s = 1; * => ; } if (s != 1) raise TEST_FAILED(); } raise_exception_1(v : int) { { raise_exception_2(v); } exception e { "do not catch" => raise TEST_FAILED();