diff options
Diffstat (limited to 'libslang/src/test')
27 files changed, 3348 insertions, 0 deletions
diff --git a/libslang/src/test/Makefile b/libslang/src/test/Makefile new file mode 100644 index 0000000..85f64dd --- /dev/null +++ b/libslang/src/test/Makefile @@ -0,0 +1,22 @@ +TEST_SCRIPTS = syntax sscanf loops arith array strops bstring \ + pack stdio assoc selfload struct nspace ospath ifeval anytype arrmult \ + nspace2 prep +TEST_PGM = sltest +RUN_TEST_PGM = ./$(TEST_PGM) +SLANGINC = .. +SLANGLIB = ../$(ARCH)objs + +run_tests: $(TEST_PGM) + @echo "" + @echo "Running tests:" + @echo "" + @for X in $(TEST_SCRIPTS); \ + do \ + $(RUN_TEST_PGM) $$X.sl; \ + done + touch sltest.c + +sltest: sltest.c $(SLANGLIB)/libslang.a + $(CC) $(CFLAGS) $(LDFLAGS) sltest.c -o sltest -I$(SLANGINC) -L$(SLANGLIB) -lslang $(TCAPLIB) -lm +clean: + -/bin/rm -f *~ sltest *.o *.log diff --git a/libslang/src/test/README b/libslang/src/test/README new file mode 100644 index 0000000..57c1cad --- /dev/null +++ b/libslang/src/test/README @@ -0,0 +1,2 @@ +These are a set of tests designed to test the interpreter. The tests +should be run from this directory using, e.g., the calc program or slsh. diff --git a/libslang/src/test/anytype.sl b/libslang/src/test/anytype.sl new file mode 100644 index 0000000..80af7dc --- /dev/null +++ b/libslang/src/test/anytype.sl @@ -0,0 +1,63 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing Any_Type ..."); + +% Tests go here.... + +variable A = Any_Type[10]; +if ((_typeof(A)) != Any_Type) failed ("_typeof"); + +static define eqs (a, b) +{ + variable len; + len = length (a); + if (len != length (b)) + return 0; + + len == length (where (a == b)); +} + +static define neqs (a, b) +{ + not (eqs (a, b)); +} + +static define check (a, i, value) +{ + a[i] = value; + if (typeof (a[i]) != Any_Type) + failed ("check typeof"); + % Because value can be an array, use neqs + if (neqs(@a[i], value)) + failed ("a[i] = value for %S, computed: %S", value, @a[i]); +} + +check (A, 0, "hello"); +check (A, 0, 14); +#ifexists Double_Type +check (A, 0, 2.3); +#endif +check (A, 0, &A); +check (A, 0, [1:10]); +#ifexists Complex_Type +check (A, 0, 1+2i); +#endif +check (A, 0, String_Type); + +A = ["a", "ab", "abc"]; +static variable B = typecast (A, Any_Type); +if ((typeof (B) != Array_Type) + or (_typeof(B) != Any_Type)) + failed ("typecast to Any_Type"); +_for (0, length(B)-1, 1) +{ + $1 = (); + if (A[$1] != @B[$1]) + failed ("@typecast(A,Any_Type)"); +} + + +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/arith.sl b/libslang/src/test/arith.sl new file mode 100644 index 0000000..d62fb3a --- /dev/null +++ b/libslang/src/test/arith.sl @@ -0,0 +1,201 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing Arithmetic ..."); + +static variable G = 11; +define check_global_local () +{ + variable x = 1; + if (G + 1 != 12) + failed ("global + int"); + if (1 + G != 12) + failed ("int + global"); + if (x + 11 != 12) + failed ("local + int"); + if (11 + x != 12) + failed ("int + local"); + if (x + x != 2) + failed ("local + local"); + if (x + G != 12) + failed ("local + global"); + if (G + x != 12) + failed ("global + local"); + if (1 + 11 != 12) + failed ("int + int"); +} +check_global_local (); + +define check_typeof (expr, type) +{ + if (typeof (expr) != type) + failed ("typeof " + string (type) + " found " + string (typeof(expr))); +} + +define check_bool (i) +{ + check_typeof (i == i, Char_Type); +} + +define check_sum_result (i, j, k) +{ + if (k != i + j) + failed (sprintf("%S + %S != %S", typeof (i), typeof(j), typeof(k))); +} + +check_typeof('a', UChar_Type); +check_typeof(1h, Short_Type); +check_typeof(1hu, UShort_Type); +check_typeof(0x20hu, UShort_Type); +check_typeof(1, Integer_Type); +check_typeof(0x20, Integer_Type); +check_typeof(1u, UInteger_Type); +check_typeof(1LU, ULong_Type); +#ifexists Double_Type +check_typeof(1f, Float_Type); +check_typeof(1e10f, Float_Type); +check_typeof(.1e10f, Float_Type); +check_typeof(.1e10, Double_Type); +#endif +check_typeof(~'a', UChar_Type); +check_typeof(~1h, Short_Type); +check_typeof(~1hu, UShort_Type); +check_typeof(~0x20hu, UShort_Type); +check_typeof(~1, Integer_Type); +check_typeof(~0x20, Integer_Type); +check_typeof(~1u, UInteger_Type); +check_typeof(~1LU, ULong_Type); + +check_typeof ('a' + 'b', Integer_Type); +check_typeof (1h + 'b', Integer_Type); + +if (Integer_Type == Short_Type) check_typeof (1hu + 'b', UInteger_Type); +else check_typeof (1hu + 'b', Integer_Type); + +check_typeof (1u + 1, UInteger_Type); + +if (Integer_Type == Long_Type) check_typeof (1u + 1L, ULong_Type); +else check_typeof (1u + 1L, Long_Type); + +check_typeof (1u + 1UL, ULong_Type); +#ifexists Double_Type +check_typeof (1u + 1.0f, Float_Type); +check_typeof (1u + 1.0, Double_Type); +#endif +#ifexists Complex_Type +check_typeof ('c' * 1i, Complex_Type); +check_typeof (1h * 1i, Complex_Type); +check_typeof (1.0 * 1i, Complex_Type); +check_typeof (1i * 1i, Complex_Type); +#endif + +check_bool ('a'); +check_bool (1h); +check_bool (1hu); +check_bool (1); +check_bool (1u); +check_bool (1L); +check_bool (1LU); +#ifexists Double_Type +check_bool (1f); +check_bool (1.0); +#endif +#ifexists Complex_Type +check_bool (1.0i); +#endif + +#ifexists Complex_Type +check_typeof (Real(1), Double_Type); +check_typeof (Real('a'), Double_Type); +check_typeof (Real(1L), Double_Type); +check_typeof (Real(1f), Float_Type); +check_typeof (Real(1.0), Double_Type); +#endif + +check_sum_result (1, 1, 2); +check_sum_result (1, 0x31, 50); +check_sum_result (1, '1', 50); +check_sum_result (1L, '1', 50L); +check_sum_result (1L, 1h, 2L); +check_sum_result (1, 1h, 2); +check_sum_result (1h, '1', 50); +check_sum_result (1u, 3, 4); +check_sum_result (1UL, '\x3', 4UL); + +#ifexists Complex_Type +static define check_complex_fun (fun, x) +{ + variable z = x + 0i; + variable diff = abs (@fun(z) - @fun(x)); + if (diff > 1e-13) + failed ("%S %S", fun, z); +} + +check_complex_fun (&sin, 1); +check_complex_fun (&cos, 1); +check_complex_fun (&tan, 1); +check_complex_fun (&acos, 0.5); +check_complex_fun (&asin, 0.5); +check_complex_fun (&atan, 0.5); +check_complex_fun (&cosh, 1); +check_complex_fun (&sinh, 1); +check_complex_fun (&tanh, 1); +check_complex_fun (&asinh, 0.5); +check_complex_fun (&acosh, 2.0); +check_complex_fun (&atanh, 0.5); +check_complex_fun (&sqrt, 0.5); +check_complex_fun (&exp, 0.5); +#endif + +define test_eqs (a, b, r) +{ + if (r != __eqs (a,b)) + failed ("__eqs (%S,%S)", a, b); +} + +test_eqs (1,1,1); +test_eqs (1,'\001', 0); +#ifexists Double_Type +test_eqs (1, 1.0, 0); +#endif +test_eqs ("xyz", "xyz", 1); +test_eqs ([1:3],[1:3],0); +test_eqs (stdout, stderr, 0); +test_eqs (stderr, 1, 0); +#ifexists Complex_Type +test_eqs (1+2i, 1+2i, 1); +test_eqs (1.0+0.0i, 1.0, 0); +#endif + +#ifexists Double_Type +define another_test () +{ + variable x = 1.0; + variable y; + + if (18 != 1.0+1+x + + 1.0+x+1 + + x+1.0+1 + + x+1+1.0 + + 1+1.0+x + + 1+x+1.0) + failed ("sum combinations"); +} + +another_test(); +#endif + +define test_typecast () +{ + variable args = __pop_args (_NARGS-1); + variable y = (); + + if (y != typecast (__push_args (args))) + failed ("typecast"); +} + +#ifexists Double_Type +test_typecast (0.0f, 0, Float_Type); +#endif + +print ("Ok\n"); +exit (0); diff --git a/libslang/src/test/array.sl b/libslang/src/test/array.sl new file mode 100644 index 0000000..2bd68c6 --- /dev/null +++ b/libslang/src/test/array.sl @@ -0,0 +1,704 @@ + +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing array functions ..."); + +static variable A = [0:23]; + +static variable B = transpose(A); +static variable dims; + +(dims,,) = array_info (B); +if ((dims[0] != 1) + or (dims[1] != 24)) + failed ("transpose ([0:23])"); + + +reshape (A, [2,3,4]); + +static define eqs (a, b) +{ + variable len; + len = length (a); + if (len != length (b)) + return 0; + + len == length (where (a == b)); +} + +static define neqs (a, b) +{ + not (eqs (a, b)); +} + + +if ((A[0,0,0] != 0) + or (A[0,0,1] != 1) + or (neqs (A[0,0,[:]], [0:3])) + or (neqs (A[0,1,[:]], [4:7])) + or (neqs (A[0,2,[:]], [8:11])) + or (neqs (A[1,0,[:]], [12:15])) + or (neqs (A[1,1,[:]], [16:19])) + or (neqs (A[1,2,[:]], [20:23]))) failed ("reshape"); + +B = transpose (A); + +if ((B[0,0,0] != 0) + or (B[1,0,0] != 1) + or (neqs (B[[:],0,0], [0:3])) + or (neqs (B[[:],1,0], [4:7])) + or (neqs (B[[:],2,0], [8:11])) + or (neqs (B[[:],0,1], [12:15])) + or (neqs (B[[:],1,1], [16:19])) + or (neqs (B[[:],2,1], [20:23]))) failed ("transpose int array"); + +% Test for memory leak +loop (100) B = transpose (B); +B = 0; + +% Try on a string array +variable S = String_Type[length (A)]; +foreach (A) +{ + variable i = (); + S[i] = string (i); +} + +variable T = @S; +reshape (S, [2,3,4]); + +if ((S[0,0,0] != T[0]) + or (S[0,0,1] != T[1]) + or (neqs (S[0,0,*], T[[0:3]])) + or (neqs (S[0,1,*], T[[4:7]])) + or (neqs (S[0,2,*], T[[8:11]])) + or (neqs (S[1,0,*], T[[12:15]])) + or (neqs (S[1,1,*], T[[16:19]])) + or (neqs (S[1,2,*], T[[20:23]]))) failed ("reshape string array"); + +S = transpose (S); + +if ((S[0,0,0] != T[0]) + or (S[1,0,0] != T[1]) + or (neqs (S[*,0,0], T[[0:3]])) + or (neqs (S[*,1,0], T[[4:7]])) + or (neqs (S[*,2,0], T[[8:11]])) + or (neqs (S[*,0,1], T[[12:15]])) + or (neqs (S[*,1,1], T[[16:19]])) + or (neqs (S[*,2,1], T[[20:23]]))) failed ("transpose string array"); + + +S = ["", "1", "12", "123", "1234", "12345"]; +S = array_map (Int_Type, &strlen, S); +if (neqs (S, [0:5])) failed ("array_map 1"); + +S = ["", "1", "12", "123", "1234", "12345"]; +variable SS = S + S; +if (neqs (SS, array_map (String_Type, &strcat, S, S))) failed ("array_map 2"); + +SS = S + "--end"; +if (neqs (SS, array_map (String_Type, &strcat, S, "--end"))) failed ("array_map 3"); + +#ifexists Double_Type +S = [1:20:0.1]; +if (neqs (sin(S), array_map (Double_Type, &sin, S))) failed ("array_map 3"); + +S = [1:20:0.1]; +variable Sin_S = Double_Type[length(S)]; +static define void_sin (x, i) +{ + Sin_S[i] = sin (x); +} +array_map (Void_Type, &void_sin, S, [0:length(S)-1]); +if (neqs (sin(S), Sin_S)) + failed ("array_map Void_Type"); +#endif + +% Check indexing with negative subscripts +S = [0:10]; + +if (S[-1] != 10) failed ("[-1]"); +if (length (S[[-1:3]])) failed ("[-1:3]"); +if (neqs(S[[-1:0:-1]], [10:0:-1])) failed ("[-1:0:-1]"); +if (neqs(S[[0:-1]], S)) failed ("[0:-1]"); +if (neqs(S[[3:-1]], [3:10])) failed ([3:-1]); +if (length (S[[0:-1:-1]])) failed ("[0:-1:-1]"); % first to last by -1 +if (neqs(S[[0:]], S)) failed ("[0:]"); +if (neqs(S[[:-1]], S)) failed ("[:-1]"); + +S = Int_Type[0]; +if (length (S) != 0) failed ("Int_Type[0]"); +if (neqs (S, S[[0:-1]])) failed ("Int_Type[0][[0:-1]]"); + + +S = bstring_to_array ("hello"); +if ((length (S) != 5) + or (typeof (S) != Array_Type)) failed ("bstring_to_array"); +if ("hello" != array_to_bstring (S)) failed ("array_to_bstring"); + +A = ['a':'z']; +foreach (A) +{ + $1 = (); + if (A[$1 - 'a'] != $1) + failed ("['a':'z']"); +} + +define check_result (result, answer, op) +{ + if (neqs (answer, result)) + failed ("Binary operation `%s' failed", op); +} + +check_result ([1,2] + [3,4], [4,6],"+"); +check_result (1 + [3,4], [4,5],"+"); +check_result ([3,4] + 1, [4,5],"+"); + +check_result ([1,2] - [3,4], [-2,-2],"-"); +check_result (1 - [3,4], [-2,-3],"-"); +check_result ([3,4] - 1, [2,3],"-"); + +check_result ([1,2] * [3,4], [3,8], "*"); +check_result (1 * [3,4], [3,4], "*"); +check_result ([3,4] * 1, [3,4], "*"); + +check_result ([12,24] / [3,4], [4,6],"/"); +check_result (12 / [3,4], [4,3],"/"); +check_result ([3,4] / 1, [3,4],"/"); + +check_result ([1,2] mod [3,4], [1,2],"mod"); +check_result (3 mod [3,2], [0,1],"mod"); +check_result ([3,4] mod 4, [3,0],"mod"); + +check_result ([1,2] == [3,2], [0,1],"=="); +check_result (3 == [3,4], [1,0],"=="); +check_result ([3,4] == 1, [0,0],"=="); + +check_result ([1,2] != [3,2], [1,0],"!="); +check_result (3 != [3,4], [0,1],"!="); +check_result ([3,4] != 1, [1,1],"!="); + +check_result ([1,2] > [3,2], [0,0],">"); +check_result (1 > [3,4], [0,0],">"); +check_result ([3,4] > 1, [1,1],">"); + +check_result ([1,2] >= [3,2], [0,1],">="); +check_result (1 >= [3,4], [0,0],">="); +check_result ([3,4] >= 1, [1,1],">="); + +check_result ([1,2] >= [3,2], [0,1],">="); +check_result (1 >= [3,4], [0,0],">="); +check_result ([3,4] >= 1, [1,1],">="); + +check_result ([1,2] < [3,2], [1,0],"<"); +check_result (1 < [3,4], [1,1],"<"); +check_result ([3,4] < 1, [0,0],"<"); + +check_result ([1,2] <= [3,2], [1,1],"<="); +check_result (1 <= [3,4], [1,1],"<="); +check_result ([3,4] <= 1, [0,0],"<="); +#ifexists Double_Type +check_result ([1,2] ^ [3,2], [1,4],"^"); +check_result (1 ^ [3,4], [1,1],"^"); +check_result ([3,4] ^ 1, [3,4],"^"); +check_result ([3,4] ^ 0, [1,1],"^"); +#endif +check_result ([1,2] or [3,2], [1,1],"or"); +check_result (1 or [3,4], [1,1],"or"); +check_result ([0,1] or 1, [1,1],"or"); + +check_result ([1,2] and [3,2], [1,1],"and"); +check_result (1 and [0,4], [0,1],"and"); +check_result ([3,4] and 0, [0,0],"and"); + +check_result ([1,2] & [3,2], [1,2],"&"); +check_result (1 & [3,4], [1,0],"&"); +check_result ([3,4] & 1, [1,0],"&"); + +check_result ([1,2] | [3,2], [3,2],"|"); +check_result (1 | [3,4], [3,5],"|"); +check_result ([3,4] | 1, [3,5],"|"); + +check_result ([1,2] xor [3,2], [2,0],"xor"); +check_result (1 xor [3,4], [2,5],"xor"); +check_result ([3,4] xor 1, [2,5],"xor"); + +check_result ([1,2] shl [3,2], [8,8],"shl"); +check_result (1 shl [3,4], [8,16],"shl"); +check_result ([3,4] shl 1, [6,8],"shl"); + +check_result ([1,4] shr [3,1], [0,2],"shr"); +check_result (8 shr [3,4], [1,0],"shr"); +check_result ([3,4] shr 1, [1,2],"shr"); + +% Test __tmp optimizations +static define test_tmp () +{ + variable x = [1:100]; + x = 1*__tmp(x)*1 + 1; + if (neqs (x), [2:101]) + failed ("__tmp optimizations"); +} + +static define ones () +{ + variable a; + + a = __pop_args (_NARGS); + return @Array_Type (Integer_Type, [__push_args (a)]) + 1; +} + +variable X = ones (5, 10); + +(dims,,) = array_info (X); +if ((dims[0] != 5) or (dims[1] != 10)) + failed ("ones dims"); +if (length (where (X != 1))) + failed ("ones 1"); + + +define test_assignments (x, i, a) +{ + variable y, z; + + y = @x; z = @x; y[i] += a; z[i] = z[i] + a; check_result (y, z, "[]+="); + y = @x; z = @x; y[i] -= a; z[i] = z[i] - a; check_result (y, z, "[]-="); + y = @x; z = @x; y[i] /= a; z[i] = z[i] / a; check_result (y, z, "[]/="); + y = @x; z = @x; y[i] *= a; z[i] = z[i] * a; check_result (y, z, "[]*="); + + y = @x; z = @x; y[i]++; z[i] = z[i] + 1; check_result (y, z, "[]++"); + y = @x; z = @x; y[i]--; z[i] = z[i] - 1; check_result (y, z, "[]--"); +} + +test_assignments ([1:10], 3, 5); +test_assignments ([1:10], [3], 5); +test_assignments ([1:10], [1,3,5], 5); + +% Test semi-open intervals +define test_semiopen (a, b, dx, n) +{ + variable last, first; + variable aa = [a:b:dx]; + + if (length (aa) != n) + failed ("test_semiopen (%S,%S,%S,%S): length==>%d", a, b, dx, n, length(aa)); + + if (n == 0) + return; + + first = aa[0]; + if (first != a) + failed ("test_semiopen (%S,%S,%S,%S): first", a, b, dx, n); + + last = a[-1]; + if (dx > 0) + { + if (last >= b) + failed ("test_semiopen (%S,%S,%S,%S): last", a, b, dx, n); + } + else if (last <= b) + failed ("test_semiopen (%S,%S,%S,%S): last", a, b, dx, n); +} +#ifexists Double_Type +test_semiopen (1.0, 10.0, 1.0, 9); +test_semiopen (1.0, 1.0, 12.0, 0); +test_semiopen (1.0, 1.2, -1.0, 0); +test_semiopen (1.0, 0.0, -1.0, 1); +test_semiopen (1.0, -0.0001, -1.0, 2); +#endif + +A = 3; if (typeof (A[*]) != Array_Type) failed ("A[*]"); + +static define test_inline_array (a, type) +{ + if (_typeof (a) != type) + failed ("test_inline_array: %S is not %S type", a, type); +} + +test_inline_array ([1,2,3], Int_Type); +test_inline_array ([1L,2L,3L], Long_Type); +test_inline_array ([1h,2h,3h], Short_Type); +#ifexists Double_Type +test_inline_array ([1f, 0, 0], Float_Type); +test_inline_array ([1f, 0.0, 0h], Double_Type); +#endif +#ifexists Complex_Type +test_inline_array ([1f, 0.0, 0i], Complex_Type); +test_inline_array ([1i, 0h, 0i], Complex_Type); +test_inline_array ([0h, 0i], Complex_Type); +test_inline_array ([0i, 0i], Complex_Type); +#endif +test_inline_array (["a", "b"], String_Type); + +A = String_Type[10]; +A[*] = "a"; +if ("aaaaaaaaaa" != strjoin (A, "")) + failed ("A[*]"); +A[5] = NULL; +if ((A[5] != NULL) + or ("aaaaaaaaa" != strjoin (A[[0,1,2,3,4,6,7,8,9]], ""))) + failed ("A[5] != NULL"); + +A[1] = NULL; +if ((length(where(_isnull(A))) != 2) + or (where (_isnull(A))[0] != 1) + or (where (_isnull(A))[1] != 5)) + failed ("_isnull: %S", where(_isnull(A))[1] != 5); + +A[*] = "a"; +if ("aaaaaaaaaa" != strjoin (A, "")) + failed ("A[5]=a"); +A[[3,7]] = NULL; +if ((A[3] != NULL) or (A[7] != NULL) + or ("aaaaaaaa" != strjoin (A[[0,1,2,4,5,6,8,9]], ""))) + failed ("A[3,7]=NULL"); + +A = String_Type[10]; +A[*] = "a"; +A[1] = NULL; +if (length (where (A != String_Type[10])) != 9) + failed ("A != String_Type[10]"); + + +% Test array summing operations +#ifexists Double_Type +static define compute_sum (a, n) +{ + variable s = 0; + variable b; + variable i, j, k; + variable dims; + + (dims,,) = array_info (a); + if (n == 0) + { + b = Double_Type[dims[1],dims[2]]; + for (i = 0; i < dims[1]; i++) + { + for (j = 0; j < dims[2]; j++) + { + for (k = 0; k < dims[n]; k++) + b[i,j] += a[k,i,j]; + } + } + return b; + } + if (n == 1) + { + b = Double_Type[dims[0],dims[2]]; + for (i = 0; i < dims[0]; i++) + { + for (j = 0; j < dims[2]; j++) + { + for (k = 0; k < dims[n]; k++) + b[i,j] += a[i,k,j]; + } + } + return b; + } + if (n == 2) + { + b = Double_Type[dims[0],dims[1]]; + for (i = 0; i < dims[0]; i++) + { + for (j = 0; j < dims[1]; j++) + { + for (k = 0; k < dims[n]; k++) + b[i,j] += a[i,j,k]; + } + } + return b; + } + + b = 0.0; + for (i = 0; i < dims[0]; i++) + { + for (j = 0; j < dims[1]; j++) + { + for (k = 0; k < dims[2]; k++) + b += a[i,j,k]; + } + } + return b; +} + +A = [1:3*4*5]; +reshape (A, [3,4,5]); + +define test_sum (a, n) +{ + variable s1, s2; + + if (n == -1) + s1 = sum(A); + else + s1 = sum(A,n); + + s2 = compute_sum (A, n); + + if (neqs (s1, s2)) + { + failed ("sum(A,%d): %S != %S: %g != %g", n, s1, s2, s1[0,0], s2[0,0]); + } +} + +test_sum (A,-1); +test_sum (A,2); +test_sum (A,1); +test_sum (A,0); + +A = [1+2i, 2+3i, 3+4i]; +if (sum(A) != A[0] + A[1] + A[2]) + failed ("sum(Complex)"); +#endif % Double_Type + +define find_min (a) +{ + variable m = a[0]; + _for (1, length(a)-1, 1) + { + variable i = (); + if (a[i] < m) + m = a[i]; + } + return m; +} + +define find_max (a) +{ + variable m = a[0]; + _for (1, length(a)-1, 1) + { + variable i = (); + if (a[i] > m) + m = a[i]; + } + return m; +} + +define test_eqs (what, a, b) +{ + if (_typeof(a) != _typeof(b)) + failed ("%s: %S != %S", what, a, b); + + if (neqs (a, b)) + failed ("%s: %S != %S", what, a, b); +} + +A = [1:10]; +test_eqs ("min", min(A), find_min(A)); +test_eqs ("max", max(A), find_max(A)); +#ifexists Double_Type +A *= 1.0f; +test_eqs ("min", min(A), find_min(A)); +test_eqs ("max", max(A), find_max(A)); +A *= 1.0; +test_eqs ("min", min(A), find_min(A)); +test_eqs ("max", max(A), find_max(A)); +#endif +A = [1h:10h]; +test_eqs ("min", min(A), find_min(A)); +test_eqs ("max", max(A), find_max(A)); +A = ['0':'9']; +test_eqs ("min", min(A), find_min(A)); +test_eqs ("max", max(A), find_max(A)); + +A=Int_Type[10,10]; +A[*,*] = [0:99]; +if (length (A[[0:99:11]]) != 10) + failed ("A[[0:99:11]"); + +#ifexists cumsum +static define do_cumsum (a) +{ + variable b = 1.0 * a; + variable i, s; + + s = 0; + _for (0, length(a)-1, 1) + { + i = (); + s += a[i]; + b[i] = s; + } + return b; +} + +static define test_cumsum (a, k, result_type) +{ + variable b = 1.0 * a; + variable bb; + + variable dims, ndims; + variable i, j; + (dims, ndims, ) = array_info (a); + + if (k != -1) + bb = cumsum (a, k); + else + bb = cumsum (a); + + if (_typeof (bb) != result_type) + { + failed ("cumsum(%S) has wrong return type (%S)", a, b); + } +#ifexists Complex_Type + if ((_typeof (a) != Complex_Type) and (_typeof (a) != Float_Type)) +#endif + a = typecast (a, Double_Type); + + if (k == -1) + { + b = do_cumsum (_reshape (a, [length(a)])); + } + else switch (ndims) + { + case 1: + b = cumsum (a); + } + { + case 2: + if (k == 0) + { + %a_j = cumsum_i a_ij + _for (0, dims[1]-1, 1) + { + j = (); + b[*, j] = do_cumsum (a[*, j]); + } + } + else + { + _for (0, dims[1]-1, 1) + { + i = (); + b[i, *] = do_cumsum (a[i, *]); + } + } + } + { + case 3: + if (k == 0) + { + %a_j = cumsum_i a_ij + _for (0, dims[1]-1, 1) + { + i = (); + _for (0, dims[2]-1, 1) + { + j = (); + b[*, i, j] = do_cumsum (a[*, i, j]); + } + } + } + else if (k == 1) + { + _for (0, dims[0]-1, 1) + { + i = (); + _for (0, dims[2]-1, 1) + { + j = (); + b[i, *, j] = do_cumsum (a[i, *, j]); + } + } + } + else + { + _for (0, dims[0]-1, 1) + { + i = (); + _for (0, dims[1]-1, 1) + { + j = (); + b[i, j, *] = do_cumsum (a[i, j, *]); + } + } + } + } + + if (neqs (b, bb)) + { + failed ("cumsum (%S, %d), expected %S, got %S", a, k, b, bb); + } +} + + +A = Int_Type[10]; A[*] = 1; +test_cumsum (A, -1, Double_Type); +test_cumsum (A, 0, Double_Type); +A = [1:3*4*5]; +reshape (A, [3,4,5]); +test_cumsum (A, -1, Double_Type); +test_cumsum (A, 0, Double_Type); +test_cumsum (A, 1, Double_Type); +test_cumsum (A, 2, Double_Type); + +A = Char_Type[10]; A[*] = 1; +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +A = [1:3*4*5]; A = typecast (A, Char_Type); +reshape (A, [3,4,5]); +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +test_cumsum (A, 1, Float_Type); +test_cumsum (A, 2, Float_Type); + +A = UChar_Type[10]; A[*] = 1; +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +A = [1:3*4*5]; A = typecast (A, UChar_Type); +reshape (A, [3,4,5]); +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +test_cumsum (A, 1, Float_Type); +test_cumsum (A, 2, Float_Type); + +A = Short_Type[10]; A[*] = 1; +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +A = [1:3*4*5]; A = typecast (A, Short_Type); +reshape (A, [3,4,5]); +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +test_cumsum (A, 1, Float_Type); +test_cumsum (A, 2, Float_Type); + +A = UShort_Type[10]; A[*] = 1; +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +A = [1:3*4*5]; A = typecast (A, UShort_Type); +reshape (A, [3,4,5]); +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +test_cumsum (A, 1, Float_Type); +test_cumsum (A, 2, Float_Type); + +A = Float_Type[10]; A[*] = 1; +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +A = [1:3*4*5]*1.0f; +reshape (A, [3,4,5]); +test_cumsum (A, -1, Float_Type); +test_cumsum (A, 0, Float_Type); +test_cumsum (A, 1, Float_Type); +test_cumsum (A, 2, Float_Type); + +#ifexists Complex_Type +A = Complex_Type[10]; A[*] = 1; +test_cumsum (A, -1, Complex_Type); +test_cumsum (A, 0, Complex_Type); +A = [1:3*4*5] + 2i*[1:3*4*5]; +reshape (A, [3,4,5]); +test_cumsum (A, -1, Complex_Type); +test_cumsum (A, 0, Complex_Type); +test_cumsum (A, 1, Complex_Type); +test_cumsum (A, 2, Complex_Type); +#endif + +#endif + +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/arrmult.sl b/libslang/src/test/arrmult.sl new file mode 100644 index 0000000..cd0cca8 --- /dev/null +++ b/libslang/src/test/arrmult.sl @@ -0,0 +1,163 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing Matrix Multiplications ..."); +#ifexists Double_Type + +static define dot_prod (a, b) +{ + (a # b)[0]; % transpose not needed for 1-d arrays +} + +static define sum (a) +{ + variable ones = Double_Type [length (a)] + 1; + dot_prod (a, ones); +} + + +if (1+2+3+4+5 != sum([1,2,3,4,5])) + failed ("sum"); + +#ifexists Complex_Type +if (1+2i != sum ([1,2i])) + failed ("sum complex"); +#endif + +define mult (a, b) +{ + variable dims_a, dims_b; + variable nr_a, nr_b, nc_a, nc_b; + variable i, j; + variable c; + + (dims_a,,) = array_info (a); + (dims_b,,) = array_info (b); + nr_a = dims_a[0]; + nc_a = dims_a[1]; + nr_b = dims_b[0]; + nc_b = dims_b[1]; + + c = _typeof ([a[0,0]]#[b[0,0]])[nr_a, nc_b]; + + for (i = 0; i < nr_a; i++) + { + for (j = 0; j < nc_b; j++) + c[i,j] = dot_prod (a[i,*], b[*,j]); + } + return c; +} + +static define arr_cmp (a, b) +{ + variable i = length (where (b != a)); + if (i == 0) + return 0; + + i = where (b != a); + a = a[i]; + b = b[i]; + reshape (a, [length(a)]); + reshape (b, [length(b)]); + vmessage ("%S != %S\n", a[0], b[0]); + return 1; +} + +static define test (a, b) +{ + if (0 != arr_cmp (mult (a,b), a#b)) + failed ("%S # %S", a, b); +} + +variable A, B; + +#ifexists Complex_Type +A = [1+2i]; +B = [3+4i]; +reshape (A, [1, 1]); +reshape (B, [1, 1]); +test (A,B); +#endif + +% Test intgers +A = _reshape ([[1, 2, 3], [4, 5, 6]], [2,3]); +B = _reshape ([[7,8,9],[1,2,4]], [2,3]); +B = transpose (B); + +test (A, B); + +B *= 1f; +test (A, B); + +B *= 1.0; +test (A,B); + +A *= 1f; +test (A,B); + +#ifexists Complex_Type +B += 2i; +test (A,B); + +A += 3i; +test (A,B); + +B = Real(B); +test (A,B); + +% Now try an empty array + +if (Complex_Type != _typeof (Complex_Type[0,0,0] # Complex_Type[0])) + failed ("[]#[]"); +#endif +% And finally, do a 3-d array: + +A = _reshape ([1:2*3*4], [2,3,4]); +B = _reshape ([1:4*5*6], [4,5,6]); +static variable C = A#B; + +% C should be a [2,3,5,6] matrix. Let's check via brute force + +static define multiply_3d (a, b, c) +{ + variable i, j, k, l, m; + variable dims_a, dims_b; + + (dims_a,,) = array_info(a); + (dims_b,,) = array_info(b); + + _for (0, dims_a[0]-1, 1) + { + i = (); + _for (0, dims_a[1]-1, 1) + { + j = (); + _for (0, dims_b[1]-1, 1) + { + l = (); + _for (0, dims_b[2]-1, 1) + { + m = (); + + variable sum = 0; + _for (0, dims_b[0]-1, 1) + { + k = (); + sum += a[i,j,k] * b[k, l, m]; + } + if (sum != c[i,j,l,m]) + failed ("multiply_3d"); + } + } + } + } +} + +multiply_3d (A, B, C); + + +print ("Ok\n"); +#else +print ("Not available\n"); +#endif +exit (0); + diff --git a/libslang/src/test/assoc.sl b/libslang/src/test/assoc.sl new file mode 100644 index 0000000..2576f46 --- /dev/null +++ b/libslang/src/test/assoc.sl @@ -0,0 +1,135 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing Associative Arrays ..."); + +static define key_to_value (k) +{ + return "<<<" + k + ">>>"; +} + +static define value_to_key (v) +{ + strcompress (v, "<>"); +} + +static define add_to_x (x, k) +{ + x[k] = key_to_value(k); +} + +static variable Default_Value = "****Default-Value****"; + +define setup (type) +{ + variable x = Assoc_Type [type, Default_Value]; + + add_to_x (x, "foo"); + add_to_x (x, "bar"); + add_to_x (x, "silly"); + add_to_x (x, "cow"); + add_to_x (x, "dog"); + add_to_x (x, "chicken"); + + return x; +} + +static variable X; + +% Test create/destuction of arrays +loop (20) X = setup (Any_Type); + +loop (20) X = setup (String_Type); + +static variable k, v; + +foreach (X) +{ + (k, v) = (); + if ((k != value_to_key(v)) or (v != key_to_value (k)) + or (X[k] != v)) + failed ("foreach"); +} + +foreach (X) using ("keys") +{ + k = (); + if (X[k] != key_to_value (k)) + failed ("foreach using keys"); +} + +foreach (X) using ("keys", "values") +{ + (k, v) = (); + if ((k != value_to_key(v)) or (v != key_to_value (k)) + or (X[k] != v)) + failed ("foreach using keys, values"); +} + +k = assoc_get_keys (X); +v = assoc_get_values (X); + +static variable i; +_for (0, length(k)-1, 1) +{ + i = (); + if (v[i] != X[k[i]]) + failed ("assoc_get_keys/values"); + assoc_delete_key (X, k[i]); +} + +if (length (X) != 0) + error ("assoc_delete_key failed"); + +if (X["*******************"] != Default_Value) + failed ("default value"); + +static define eqs (a, b) +{ + variable len; + len = length (a); + if (len != length (b)) + return 0; + + len == length (where (a == b)); +} + +static define neqs (a, b) +{ + not (eqs (a, b)); +} + + +static define store_and_test (a, indx, value) +{ + a[indx] = value; + if (typeof (value) != typeof(a[indx])) + failed ("typeof (value)"); + if (neqs (a[indx], value)) + failed ("a[indx] != value"); +} + +X = Assoc_Type[]; + +store_and_test (X, "string", "string"); +store_and_test (X, "array", ["a", "b", "c"]); +store_and_test (X, "int", 3); +#ifexists Complex_Type +store_and_test (X, "z", 3+2i); +#endif + +static variable V = assoc_get_values (X); +static variable K = assoc_get_keys (X); + +static variable i; + +_for (0, length(X)-1, 1) +{ + i=(); + if (neqs(X[K[i]], @V[i])) + failed ("assoc_get_values"); +} + +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/bstring.sl b/libslang/src/test/bstring.sl new file mode 100644 index 0000000..3ac8a3d --- /dev/null +++ b/libslang/src/test/bstring.sl @@ -0,0 +1,32 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing Binary Strings..."); + +variable a = "\000A\000B\000C\000D"; + +if (typeof (a) != BString_Type) failed ("typeof"); + +if (bstrlen (a) != 8) failed ("bstrlen"); + +if ((a[[0:7:2]] != "\000\000\000\000") + or (a[[1:7:2]] != "ABCD")) failed ("array indexing"); + +if (strlen (a) != 0) failed ("typecast"); + +a += "XYZ"; + +if (a[[8:]] != "XYZ") failed ("+= op"); + +a = "XYZ" + a; +if (a == "XYZ") failed ("== op"); + +if (strcmp (a, "XYZ")) failed ("failed strcmp"); + +loop (1000) +{ + a = "\000A\000B\000C\000D"; + a = "A\000B\000C\000"; +} + +print ("Ok\n"); +exit (0); diff --git a/libslang/src/test/ifeval.sl b/libslang/src/test/ifeval.sl new file mode 100644 index 0000000..e0d382f --- /dev/null +++ b/libslang/src/test/ifeval.sl @@ -0,0 +1,404 @@ + +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +_debug_info = 1; () = evalfile ("inc.sl"); +#else +failed("#else"); +#endif + + +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +print ("Testing #ifeval ..."); +#else +failed("#else"); +#endif + +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +define +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +check_typeof +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +(expr, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + type) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +{ +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + if +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + (typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + expr) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + != type) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + failed ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +"typeof " + string ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +type) + " found " + string ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +typeof( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +expr))); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +} +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +static variable +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +Silly = [ +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +1, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +2, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +3, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +4, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +5, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +6]; +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +if (length (Silly) != 6) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + failed ("Silly Array"); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +Silly = [1: +#else +failed("#else"); +#endif +#ifeval variable XXX = [1:3]; XXX = [1,2,3]; length(XXX); +10]; +#else +failed("#else"); +#endif +#ifeval variable XXX = [1:3]; XXX = [1,2,3]; length(XXX); +if (length (Silly) != 10) failed ("[1:10]"); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +Silly = struct +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +{ +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + a, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {x = struct { c, d, a}; return 1;} crazy (0,0,0,0); + b, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + c +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +}; +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +Silly.a = "hello"; +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +define check_bool ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +i) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +{ +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + check_typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +i == i, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + Char_Type); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +} +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +define check_result ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +i, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + j, +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + k) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +{ +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + if ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +k != i + j) +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + failed ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +sprintf( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +"%S + %S != %S", +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +i), +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + typeof( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +j), +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + typeof( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +k))); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +} +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +check_typeof( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +'a', +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + UChar_Type); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +check_typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +'a' + 'b', +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + Integer_Type); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +check_typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +1h + 'b', +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + Integer_Type); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +if ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +Integer_Type == Short_Type) check_typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +1hu + 'b', +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + UInteger_Type); +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +else check_typeof ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +1hu + 'b', +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + Integer_Type); +#else +failed("#else"); +#endif + +print ( +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); + "Ok\n"); +exit ( +#else +failed("#else"); +#endif +#ifeval define crazy (x,y,z,w) {return 1;} crazy (0,0,0,0); +0); +#else +failed("#else"); +#endif + +failed ("Should not see this!!!"); diff --git a/libslang/src/test/inc.sl b/libslang/src/test/inc.sl new file mode 100644 index 0000000..54e3d06 --- /dev/null +++ b/libslang/src/test/inc.sl @@ -0,0 +1,15 @@ +define print (x) +{ + x = string (x); + () = fputs (x, stdout); + () = fflush (stdout); +} + +define failed () +{ + variable s = __pop_args (_NARGS); + s = sprintf (__push_args(s)); + () = fprintf (stderr, "Failed: %s\n", s); + exit (1); +} + diff --git a/libslang/src/test/loops.sl b/libslang/src/test/loops.sl new file mode 100644 index 0000000..ac22611 --- /dev/null +++ b/libslang/src/test/loops.sl @@ -0,0 +1,130 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing looping constructs ..."); + +define identity (x) +{ + return x; +} + +define test_do_while (count_fun) +{ + variable i = 0; + variable count = 0; + do + { + if (i == 3) + continue; + i++; + } + while (@count_fun (&count) < 6); + if ((count != 6) or (i != 3)) + failed ("do_while 1: %S", count_fun); + + i = 0; + count = 0; + do + { + if (i == 3) + break; + i++; + } + while (@count_fun (&count) < 6); + if ((count != 3) or (i != 3)) + failed ("do_while 2: %S", count_fun); +} + +define test_while (count_fun) +{ + variable i = 0; + variable count = 0; + + while (@count_fun (&count) < 6) + { + if (i == 3) + continue; + i++; + } + if ((count != 6) or (i != 3)) + failed ("while 1: %S", count_fun); + + i = 0; + count = 0; + while (@count_fun (&count) < 6) + { + if (i == 3) + break; + i++; + } + if ((count != 4) or (i != 3)) + failed ("while 2: %S", count_fun); +} + +define test_for (count_fun) +{ + variable i = 0; + variable count = 0; + + for (count = 0; @count_fun (&count) < 6; ) + { + if (i == 3) + continue; + i++; + } + if ((count != 6) or (i != 3)) + failed ("while 1: %S", count_fun); + + i = 0; + for (count = 0; @count_fun (&count) < 6; ) + { + if (i == 3) + break; + i++; + } + if ((count != 4) or (i != 3)) + failed ("while 2: %S", count_fun); +} + +define add_one (x) +{ + @x = @x + 1; + return @x; +} + +define add_one_with_call (x) +{ + @x = @x+1; + return identity (@x); +} + +define add_one_with_loop (x) +{ + variable i = 0; + while (1) + { + @x = @x + 1; + i++; + if (i == 3) + break; + } + @x = @x - 2; + return @x; +} + + +test_do_while (&add_one); +test_do_while (&add_one_with_call); +test_do_while (&add_one_with_loop); + +test_while (&add_one); +test_while (&add_one_with_call); +test_while (&add_one_with_loop); + +test_for (&add_one); +test_for (&add_one_with_call); +test_for (&add_one_with_loop); + +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/ns1.inc b/libslang/src/test/ns1.inc new file mode 100644 index 0000000..3ae6c68 --- /dev/null +++ b/libslang/src/test/ns1.inc @@ -0,0 +1,6 @@ +implements (This_Namespace); +private variable NS = This_Namespace; +define func () +{ + return NS; +} diff --git a/libslang/src/test/ns2.inc b/libslang/src/test/ns2.inc new file mode 100644 index 0000000..3ae6c68 --- /dev/null +++ b/libslang/src/test/ns2.inc @@ -0,0 +1,6 @@ +implements (This_Namespace); +private variable NS = This_Namespace; +define func () +{ + return NS; +} diff --git a/libslang/src/test/nspace.sl b/libslang/src/test/nspace.sl new file mode 100644 index 0000000..0b961c7 --- /dev/null +++ b/libslang/src/test/nspace.sl @@ -0,0 +1,93 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing NameSpace routines ..."); + +if (current_namespace () != "") + failed ("current_namespace - 1"); + +implements ("NSpace"); +% From this point on, define and variable defaults to static + +if (current_namespace () != "NSpace") + failed ("current_namespace - 2"); + +define static_function () +{ + "static_function"; +} +variable static_variable = "static_variable"; + +public define public_function () +{ + "public_function"; +} +public variable public_variable = "public_variable"; + +private define private_function () +{ + "private_function"; +} +private variable private_variable = "private_variable"; + +!if (is_defined ("Global->public_function")) failed ("public_function"); +!if (is_defined ("Global->public_variable")) failed ("public_variable"); +!if (is_defined ("public_function")) failed ("public_function"); +!if (is_defined ("public_variable")) failed ("public_variable"); +!if (is_defined ("NSpace->static_function")) failed ("static_function"); +!if (is_defined ("NSpace->static_variable")) failed ("static_variable"); +if (is_defined ("NSpace->private_function")) failed ("private_function"); +if (is_defined ("NSpace->private_variable")) failed ("private_variable"); + +if (static_variable != NSpace->static_variable) failed ("static_variable test"); +if (public_variable != Global->public_variable) failed ("public_variable test"); +if (private_variable != "private_variable") failed ("private_variable test"); + +public variable This_Namespace; + +This_Namespace = "NS1"; +() = evalfile ("ns1.inc"); +This_Namespace = "NS2"; +() = evalfile ("ns2.inc"); + +use_namespace ("NS1"); +if (func () != "NS1") + failed ("use_namespace 1"); +define func1 () +{ + return "1"; +} +use_namespace ("NS2"); +if (func () != "NS2") + failed ("use_namespace 2"); +define func1 () +{ + return "2"; +} +use_namespace ("Global"); +if (is_defined ("func")) + failed ("use_namespace Global"); +define func1 () +{ + return "3"; +} +!if (is_defined ("func1")) + failed ("use_namespace Global: func1"); + +if (NS1->func () != "NS1") + failed ("NS1->func"); +if (NS2->func () != "NS2") + failed ("NS2->func"); +if (NS1->func1 () != "1") + failed ("NS1->func1"); +if (NS2->func1 () != "2") + failed ("NS2->func1"); +if (Global->func1 () != "3") + failed ("Global->func1"); + +if (length (_get_namespaces ()) != 4) % Global, NS1, NS2, NSpace + failed ("_get_namespaces: %S", _get_namespaces()); + +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/nspace2.sl b/libslang/src/test/nspace2.sl new file mode 100644 index 0000000..d13c15d --- /dev/null +++ b/libslang/src/test/nspace2.sl @@ -0,0 +1,70 @@ +#ifexists This_Namespace +if (This_Namespace == "NS3") + { + if (current_namespace () != "NS3") + { + failed ("evalfile in NS3"); + } + } +else + implements (This_Namespace); +%vmessage ("Loading ..."); +% From this point on, define and variable defaults to static +private variable NS = This_Namespace; +define func () +{ + return NS; +} +#else +variable This_Namespace; +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing more NameSpace routines ..."); +This_Namespace = "NS1"; +() = evalfile (__FILE__); +This_Namespace = "NS2"; +() = evalfile (__FILE__); + +This_Namespace = "NS3"; +() = evalfile (__FILE__, "NS3"); + +use_namespace ("NS1"); +if (func () != "NS1") + failed ("use_namespace 1, found %s", func()); + +use_namespace ("NS2"); +if (func () != "NS2") + failed ("use_namespace 2"); + +use_namespace ("Global"); +if (is_defined ("func")) + failed ("use_namespace Global"); + +if (NS1->func () != "NS1") + failed ("NS1->func"); +if (NS2->func () != "NS2") + failed ("NS2->func"); + +if ("NS1" != eval ("func", "NS1")) + failed ("eval in NS1"); +if ("NS2" != eval ("func", "NS2")) + failed ("eval in NS2"); +if ("NS3" != eval ("func", "NS3")) + failed ("eval in NS3"); + +if ("NS4" != eval ("current_namespace()", "NS4")) + failed ("eval in NS4"); + +implements ("foo"); +variable X = "foo"; +implements ("bar"); +variable X = "bar"; + +if (foo->X != "foo") + failed ("foo"); +if (bar->X != "bar") + failed ("bar"); + +print ("Ok\n"); +exit (0); +#endif diff --git a/libslang/src/test/ospath.sl b/libslang/src/test/ospath.sl new file mode 100644 index 0000000..caf4a5a --- /dev/null +++ b/libslang/src/test/ospath.sl @@ -0,0 +1,42 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing ospath ..."); + +static define test_path (path, dir, base, ext, dirbase) +{ + if (dir != path_dirname (path)) + failed ("path_dirname " + path); + + if (base != path_basename (path)) + failed ("path_basename " + path); + + if (ext != path_extname (path)) + failed ("path_extname " + path); + + if (dirbase != path_concat (dir, base)) + failed ("path_concat(%s,%s)", dir, base); +} + +#ifdef UNIX +test_path ("etc/rc.d", "etc", "rc.d", ".d", "etc/rc.d"); +test_path ("etc", ".", "etc", "", "./etc"); +test_path ("usr/etc/", "usr/etc", "", "", "usr/etc/"); +test_path ("/", "/", "", "", "/"); +test_path (".", ".", ".", ".", "./."); +test_path ("/a./b", "/a.", "b", "", "/a./b"); +test_path (".c", ".", ".c", ".c", "./.c"); +#elifndef VMS +test_path ("etc\\rc.d", "etc", "rc.d", ".d", "etc\\rc.d"); +test_path ("etc", ".", "etc", "", ".\\etc"); +test_path ("usr\\etc\\", "usr\\etc", "", "", "usr\\etc\\"); +test_path ("\\", "\\", "", "", "\\"); +test_path (".", ".", ".", ".", ".\\."); +test_path ("\\a.\\b", "\\a.", "b", "", "\\a.\\b"); +test_path (".c", ".", ".c", ".c", ".\\.c"); +#else +message ("**** NOT IMPLEMENTED ****"); +#endif +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/pack.sl b/libslang/src/test/pack.sl new file mode 100644 index 0000000..7137609 --- /dev/null +++ b/libslang/src/test/pack.sl @@ -0,0 +1,107 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing pack and unpack functions..."); + +static variable is_lil_endian = (pack ("j", 0xFF)[0] == 0xFF); + +static define test_pack () +{ + variable str; + variable fmt, val, args; + + args = __pop_args (_NARGS - 2); + (fmt, val) = (); + + str = pack (fmt, __push_args (args)); + if (typeof (str) != BString_Type) + failed ("pack did not return a bstring for format = " + fmt); + if (str != val) + failed ("pack returned wrong result for format = " + + fmt + ":" + str); +} + +variable X = 0x12345678L; +variable S = "\x12\x34\x56\x78"; +if (is_lil_endian) S = "\x78\x56\x34\x12"; + +test_pack (">k", "\x12\x34\x56\x78", X); +test_pack ("<k", "\x78\x56\x34\x12", X); +test_pack ("=k", S, X); + +test_pack ("c", "X", 'X'); +test_pack ("cc", "XY", 'X', 'Y'); +test_pack ("c4", "ABCD", 'A', ['B', 'C'], 'D', 'E'); +test_pack ("xx c xx c2 x >j1", "\0\0A\0\0BC\0\xD\xE", 'A', ['B', 'C'], 0x0D0E); + +test_pack ("s4", "1234", "123456"); +test_pack ("S4", "1234", "123456"); +test_pack ("s10", "1234\0\0\0\0\0\0", "1234"); +test_pack ("S10", "1234 ", "1234"); + +define test_unpack1 (fmt, str, x, type) +{ + variable xx; + + x = typecast (x, type); + + xx = unpack (fmt, str); + + if (length (where(xx != x))) + failed ("unpack returned wrong result for " + fmt + ":" + string (xx)); +} + +#ifexists Double_Type +X = 3.14; if (X != unpack ("d", pack ("d", X))) failed ("pack->unpack for d"); +X = 3.14f; if (X != unpack ("f", pack ("f", X))) failed ("pack->unpack for f"); +#endif + +test_unpack1 (">j", "\xAB\xCD", 0xABCD, Int16_Type); +test_unpack1 (">k", "\xAB\xCD\xEF\x12", 0xABCDEF12L, Int32_Type); +test_unpack1 ("<j", "\xCD\xAB", 0xABCD, Int16_Type); +test_unpack1 ("<k", "\x12\xEF\xCD\xAB", 0xABCDEF12L, Int32_Type); + +define test_unpack2 (fmt, a, type) +{ + test_unpack1 (fmt, pack (fmt, a), a, type); +} + +test_unpack2 ("c5", [1,2,3,4,5], Char_Type); +test_unpack2 ("C5", [1,2,3,4,5], UChar_Type); +test_unpack2 ("h5", [1,2,3,4,5], Short_Type); +test_unpack2 ("H5", [1,2,3,4,5], UShort_Type); +test_unpack2 ("i5", [1,2,3,4,5], Int_Type); +test_unpack2 ("I5", [1,2,3,4,5], UInt_Type); +test_unpack2 ("l5", [1,2,3,4,5], Long_Type); +test_unpack2 ("L5", [1,2,3,4,5], ULong_Type); +#ifexists Double_Type +test_unpack2 ("f5", [1,2,3,4,5], Float_Type); +test_unpack2 ("d5", [1,2,3,4,5], Double_Type); +#endif + +test_unpack1 ("s4", "ABCDEFGHI", "ABCD", String_Type); +test_unpack1 ("S4", "ABCDEFGHI", "ABCD", String_Type); +test_unpack1 ("s5", "ABCD FGHI", "ABCD ", String_Type); +test_unpack1 ("S5", "ABCD FGHI", "ABCD", String_Type); +test_unpack1 ("S5", "ABCD\0FGHI", "ABCD", BString_Type); +test_unpack1 ("S5", " ", "", String_Type); + +define test_unpack3 (fmt, a, b) +{ + variable c, d; + variable s; + + (c, d) = unpack (fmt, pack (fmt, a, b)); + if ((a != c) or (b != d)) + failed ("unpack failed for " + fmt); +} + +#ifexists Double_Type +test_unpack3 ("x x h1 x x20 d x", 31h, 41.7); +test_unpack3 ("x x S20 x x20 d x", "FF", 41.7); +test_unpack3 ("x x d0d0d0d0 S20 x x20 d x", "FF", 41.7); +test_unpack3 ("x x0 S20 x x20 d x", "FF", 41.7); +test_unpack3 ("x x0 s5 x x20 d x", "FF\0\0\0", 41.7); +#endif +print ("Ok\n"); +exit (0); + diff --git a/libslang/src/test/posixio.sl b/libslang/src/test/posixio.sl new file mode 100644 index 0000000..d3a0dc0 --- /dev/null +++ b/libslang/src/test/posixio.sl @@ -0,0 +1,93 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + + +print ("Testing POSIX I/O routines..."); + +static define open_tmp_file (fileptr, flags, mode) +{ + variable n; + variable file, fd; + variable fmt; + + @fileptr = NULL; + + fmt = "tmp-xxx.%03d"; % I need something that works on an 8+3 filesystem + + n = -1; + while (n < 999) + { + n++; + file = sprintf (fmt, n); + if (NULL != stat_file (file)) + continue; + + fd = open (file, flags, 0777); + if (fd != NULL) + { + @fileptr = file; + return fd; + } + } + failed ("Unable to open a tmp file"); +} + +define run_tests (some_text) +{ + variable file, fd, fp; + variable new_text, nbytes, len; + variable pos; + + fd = open_tmp_file (&file, O_WRONLY|O_BINARY|O_CREAT, 0777); + + if (-1 == write (fd, some_text)) + failed ("write"); + + fp = fdopen (fd, "wb"); + if (fp == NULL) + failed ("fdopen"); + + if (isatty (fileno (fp))) + failed ("isatty (fileno)"); + + if (-1 == close (fd)) + failed ("close"); + + fd = open (file, O_RDONLY|O_BINARY); + if (fd == NULL) failed ("fopen existing"); + + len = bstrlen (some_text); + nbytes = read (fd, &new_text, len); + if (nbytes == -1) + failed ("read"); + + if ((nbytes != len) + or (some_text != new_text)) + failed ("read"); + + if (0 != read (fd, &new_text, 1)) + failed ("read at EOF"); + if (bstrlen (new_text)) + failed ("read at EOF"); + + if (-1 == close (fd)) failed ("close after tests"); + variable st = stat_file (file); + () = st.st_mode; % see if stat_file returned the right struct + () = remove (file); + if (stat_file (file) != NULL) failed ("remove"); +} + + +run_tests ("ABCDEFG"); +run_tests ("A\000BC\000\n\n\n"); + +variable fd = open ("/dev/tty", O_RDONLY); +if (fd != NULL) +{ + if (0 == isatty (fd)) + failed ("isatty"); +} +fd = 0; + + +print ("Ok\n"); +exit (0); diff --git a/libslang/src/test/prep.sl b/libslang/src/test/prep.sl new file mode 100644 index 0000000..ecf0ee7 --- /dev/null +++ b/libslang/src/test/prep.sl @@ -0,0 +1,25 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing slprep ..."); + +public variable X = 0; + +#ifdef FOO_MOO_TOO_KOO +failed ("ifdef"); +#else +X = 1; +#endif +#if (X!=1) +failed ("X!=1"); +#else +X=-1; +#endif + +#if !eval(X==-1) +failed ("eval"); +#else + +print ("Ok\n"); + +exit (0); +#endif diff --git a/libslang/src/test/selfload.sl b/libslang/src/test/selfload.sl new file mode 100644 index 0000000..a360a29 --- /dev/null +++ b/libslang/src/test/selfload.sl @@ -0,0 +1,42 @@ +% This is also a good test to perform leak checking on. +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing recursive function modifications ..."); + +variable X = ""; + +variable V1 = "define crash () { eval(V2); X += \"V1\"; }"; +variable V2 = "define crash () { eval(V1); X += \"V2\"; }"; + +define crash (); + +define crash () +{ + eval (V1); + crash (); + if (X != "V1") + failed ("V1"); + + if (1) + { + eval (V2); + crash (); + if (X != "V1V2") + failed ("V1V2"); + + if (1) + eval (V1); + crash (); + if (X != "V1V2V1") + failed ("V1V2V1"); + } + X += "V0"; +} + +crash (); +if (X != "V1V2V1V0") failed ("V1V2V1V0 : ", + X); + +print ("Ok\n"); +exit (0); + + diff --git a/libslang/src/test/sltest.c b/libslang/src/test/sltest.c new file mode 100644 index 0000000..c9f8555 --- /dev/null +++ b/libslang/src/test/sltest.c @@ -0,0 +1,182 @@ +#include <stdio.h> +#include <slang.h> +#include <math.h> + +#include "../sl-feat.h" + +#if SLANG_HAS_FLOAT +#if defined(__FreeBSD__) || defined(__386BSD__) +# include <floatingpoint.h> +# define HAVE_FPSETMASK 1 +#endif +#endif + +static int Ignore_Exit = 0; +static void c_exit (int *code) +{ + if (Ignore_Exit == 0) + exit (*code); +} + +static char test_char_return (char *x) +{ + return *x; +} +static short test_short_return (short *x) +{ + return *x; +} +static int test_int_return (int *x) +{ + return *x; +} +static long test_long_return (long *x) +{ + return *x; +} +/* static float test_float_return (float *x) */ +/* { */ +/* return *x; */ +/* } */ +#if SLANG_HAS_FLOAT +static double test_double_return (double *x) +{ + return *x; +} +#endif +typedef struct +{ + int i; + long l; + short h; + char b; +#if SLANG_HAS_FLOAT + double d; + double c[2]; +#endif + char *s; + SLang_Array_Type *a; + char *ro_str; +} +CStruct_Type; + +static SLang_CStruct_Field_Type C_Struct [] = +{ + MAKE_CSTRUCT_FIELD(CStruct_Type, i, "i", SLANG_INT_TYPE, 0), +#if SLANG_HAS_FLOAT + MAKE_CSTRUCT_FIELD(CStruct_Type, d, "d", SLANG_DOUBLE_TYPE, 0), + MAKE_CSTRUCT_FIELD(CStruct_Type, c, "z", SLANG_COMPLEX_TYPE, 0), +#endif + MAKE_CSTRUCT_FIELD(CStruct_Type, s, "s", SLANG_STRING_TYPE, 0), + MAKE_CSTRUCT_FIELD(CStruct_Type, a, "a", SLANG_ARRAY_TYPE, 0), + MAKE_CSTRUCT_FIELD(CStruct_Type, ro_str, "ro_str", SLANG_STRING_TYPE, 1), + MAKE_CSTRUCT_INT_FIELD(CStruct_Type, l, "l", 0), + MAKE_CSTRUCT_INT_FIELD(CStruct_Type, h, "h", 0), + MAKE_CSTRUCT_INT_FIELD(CStruct_Type, b, "b", 0), + SLANG_END_CSTRUCT_TABLE +}; + +static CStruct_Type C_Struct_Buf; +static void check_cstruct (void) +{ + static int first_time = 1; + if (first_time) + { + C_Struct_Buf.ro_str = "read-only"; + first_time = 0; + } +} + +static void get_c_struct (void) +{ + check_cstruct (); + (void) SLang_push_cstruct ((VOID_STAR) &C_Struct_Buf, C_Struct); +} + +static void set_c_struct (void) +{ + SLang_free_cstruct ((VOID_STAR) &C_Struct_Buf, C_Struct); + (void) SLang_pop_cstruct ((VOID_STAR) &C_Struct_Buf, C_Struct); +} + +static void get_c_struct_via_ref (SLang_Ref_Type *r) +{ + check_cstruct (); + (void) SLang_assign_cstruct_to_ref (r, (VOID_STAR) &C_Struct_Buf, C_Struct); +} + + + +static SLang_Intrin_Fun_Type Intrinsics [] = +{ + MAKE_INTRINSIC_I("exit", c_exit, VOID_TYPE), + MAKE_INTRINSIC_1("test_char_return", test_char_return, SLANG_CHAR_TYPE, SLANG_CHAR_TYPE), + MAKE_INTRINSIC_1("test_short_return", test_short_return, SLANG_SHORT_TYPE, SLANG_SHORT_TYPE), + MAKE_INTRINSIC_1("test_int_return", test_int_return, SLANG_INT_TYPE, SLANG_INT_TYPE), + MAKE_INTRINSIC_1("test_long_return", test_long_return, SLANG_LONG_TYPE, SLANG_LONG_TYPE), + /* MAKE_INTRINSIC_1("test_float_return", test_float_return, SLANG_FLOAT_TYPE, SLANG_FLOAT_TYPE), */ +#if SLANG_HAS_FLOAT + MAKE_INTRINSIC_1("test_double_return", test_double_return, SLANG_DOUBLE_TYPE, SLANG_DOUBLE_TYPE), +#endif + MAKE_INTRINSIC_0("get_c_struct", get_c_struct, VOID_TYPE), + MAKE_INTRINSIC_0("set_c_struct", set_c_struct, VOID_TYPE), + MAKE_INTRINSIC_1("get_c_struct_via_ref", get_c_struct_via_ref, VOID_TYPE, SLANG_REF_TYPE), + SLANG_END_INTRIN_FUN_TABLE +}; + + +int main (int argc, char **argv) +{ + int i; + + if (argc < 2) + { + fprintf (stderr, "Usage: %s FILE...\n", argv[0]); + return 1; + } + + if ((-1 == SLang_init_all ()) + || (-1 == SLang_init_array_extra ()) + || (-1 == SLadd_intrin_fun_table (Intrinsics, NULL))) + return 1; + + SLang_Traceback = 1; + + if (-1 == SLang_set_argc_argv (argc, argv)) + return 1; + +#ifdef HAVE_FPSETMASK +# ifndef FP_X_OFL +# define FP_X_OFL 0 +# endif +# ifndef FP_X_INV +# define FP_X_INV 0 +# endif +# ifndef FP_X_DZ +# define FP_X_DZ 0 +# endif +# ifndef FP_X_DNML +# define FP_X_DNML 0 +# endif +# ifndef FP_X_UFL +# define FP_X_UFL 0 +# endif +# ifndef FP_X_IMP +# define FP_X_IMP 0 +# endif + fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); +#endif + + if (argc > 2) + Ignore_Exit = 1; + + for (i = 1; i < argc; i++) + { + if (-1 == SLang_load_file (argv[i])) + return 1; + } + + return SLang_Error; +} + + diff --git a/libslang/src/test/sscanf.sl b/libslang/src/test/sscanf.sl new file mode 100644 index 0000000..2e588af --- /dev/null +++ b/libslang/src/test/sscanf.sl @@ -0,0 +1,182 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing sscanf ..."); + +#ifexists Double_Type +static variable eps = 1.0; +while (1 + eps/2.0 != 1) + eps /= 2.0; + +static define feqs (x, y) +{ + if (x == y) + return 1; + + % (delta_diff)^2 = (delta_y)^ + (delta_x)^2 + % delta_y = eps * y + % (delta_diff)^2 = eps*eps (y^2 + x^2) + % |delta_diff| = eps * sqrt (y^2 + x^2) ~= eps * x *sqrt(2) + variable diff = y - x; + if (x < 0) x = -x; + if (y < 0) y = -y; + if (diff < 0) diff = -diff; + variable tol = ((x + y) * eps); + + if (diff <= tol) + return 1; + vmessage ("diff = %e, abs(x)*eps = %e, error=%e", + diff, tol, diff/(x+y)); + return 1; +} + +static variable Inf = 1e1000; +static define test_atof (x) +{ + variable y; + variable str = sprintf ("%.64e", x); + variable tstr; + + tstr = strup (strtrim (str)); + + if (tstr == "INF") + y = Inf; + else if (tstr == "-INF") + y = -Inf; + else + y = atof (str); + + !if (feqs (x,y)) + failed ("%e = atof(%e [%s]): diff = %e\n", y, x, tstr, y-x); +} + +static variable _Random_Seed = 123456789UL; +static define random () +{ + _Random_Seed = (_Random_Seed * 69069UL + 1013904243UL)&0xFFFFFFFFU; + return _Random_Seed/4294967296.0; +} + +static define test_atof_main (n) +{ + + loop (n) + { + variable a,b,c; + a = 500 - random () * 1000; + b = 400 - 800 * random (); + ERROR_BLOCK + { + _clear_error (); + () = fprintf (stderr, "Floating point exception occured for %g * 10^%g\n", + a, b); + } + if (1) + { + c = a * 10.0^b; + test_atof (c); + } + } + + test_atof (random ()); +} +test_atof_main (1000); +#endif % Double_Type + +define test_scanf (buf, format, xp, yp, n) +{ + variable nn, x, y; + nn = sscanf (buf, format, &x, &y); + if (n != nn) + failed ("sscanf (%s, %s, &x, &y) ==> returned %d", + buf, format, nn); + if (n >= 1) + { + if (x != xp) + { +#ifexists Double_Type + if ((typeof (x) == Double_Type) + or (typeof (x) == Float_Type)) + { + if (1) + failed ("sscanf (%s, %s, &x, &y) ==> x = %e, diff=%e", + buf, format, x, x - xp); + } + else +#endif + failed ("sscanf (%s, %s, &x, &y) ==> x = %S", + buf, format, x); + } + } + + if (n >= 2) + { + if (y != yp) + { +#ifexists Double_Type + if ((typeof (y) == Double_Type) + or (typeof (y) == Float_Type)) + failed ("sscanf (%s, %s, &x, &y) ==> y = %e, diff=%e", + buf, format, y, y - yp); + else +#endif + failed ("sscanf (%s, %s, &x, &y) ==> y = %S", + buf, format, y); + } + } +} + +test_scanf (" -30,,XX ,,2,3", "%2hd%4s", -3, "0,,X", 2); +test_scanf ("1,2,3", "%d,%2s", 1, "2,", 2); +test_scanf ("1,2 ,3", "%d,%2s", 1, "2", 2); +test_scanf ("1,2 ,3", "%d,%20s", 1, "2", 2); +test_scanf ("1,,,,2,3", "%d,%20s", 1, ",,,2,3", 2); +test_scanf ("1, ,,,2,3", "%d,%20s", 1, ",,,2,3", 2); +test_scanf ("-30.1,,,,2,3", "%d,%2s", -30, "", 1); +test_scanf (" -30,,XX ,,2,3", "%d%4s", -30, ",,XX", 2); +test_scanf (" -30,,XX ,,2,3", "%hd%4s", -30, ",,XX", 2); +test_scanf (" -30,,XX ,,2,3", "%1hd%4s", -3, "0,,X", 0); +#ifexists Double_Type +test_scanf (" +30.173e-2,,XX ,,2,3", "%lf,,%4s", 30.173e-2, "XX", 2); +test_scanf (" -30.1,,XX ,,2,3", "%lf,,%4s", -30.1, "XX", 2); +test_scanf (" +30.1,,XX ,,2,3", "%lf,,%4s", 30.1, "XX", 2); +test_scanf (" +30.,,XX ,,2,3", "%lf,,%4s", 30.0, "XX", 2); +test_scanf (" +30.173,,XX ,,2,3", "%lf,,%4s", 30.173, "XX", 2); +test_scanf (" +30.173e+2,,XX ,,2,3", "%lf,,%4s", 30.173e2, "XX", 2); +test_scanf (" +30.173e-03,,XX ,,2,3", "%lf,,%4s", 30.173e-3, "XX", 2); +test_scanf (" +30.173E-03,,XX ,,2,3", "%lf,,%4s", 30.173e-3, "XX", 2); +test_scanf ("+.E", "%lf%lf", 0, 0, 0); +test_scanf ("+0.E", "%lf%s", 0, "E", 2); +test_scanf ("-0.E", "%lf%s", 0, "E", 2); +test_scanf ("-0.E-", "%lf%s", 0, "E-", 2); +test_scanf ("-0.E+", "%lf%s", 0, "E+", 2); +test_scanf ("-0.E+X", "%lf%s", 0, "E+X", 2); +test_scanf ("-1.E+0X", "%lf%s", -1, "X", 2); +test_scanf ("-0+X", "%lf%s", 0, "+X", 2); +test_scanf ("0+X", "%lf%s", 0, "+X", 2); +test_scanf ("0.000000000000E00+X", "%lf%s", 0, "+X", 2); +test_scanf ("1.000000000000E000000001+X", "%lf%s", 10, "+X", 2); +#endif + +test_scanf (" hello world", "%s%s", "hello", "world", 2); +test_scanf (" hello world", "%s%c", "hello", ' ', 2); +test_scanf (" hello world", "%s%2c", "hello", " w", 2); +test_scanf (" hello world", "%s%5c", "hello", " worl", 2); +test_scanf (" hello world", "%s%6c", "hello", " world", 2); +test_scanf (" hello world", "%s%7c", "hello", " world", 2); +test_scanf (" hello world", "%s%1000c", "hello", " world", 2); + +test_scanf (" hello world", "%*s%c%1000c", ' ', "world", 2); + +test_scanf ("abcdefghijk", "%[a-c]%s", "abc", "defghijk", 2); +test_scanf ("abcdefghijk", "%4[a-z]%s", "abcd", "efghijk", 2); +test_scanf ("ab[-]cdefghijk", "%4[]ab]%s", "ab", "[-]cdefghijk", 2); +test_scanf ("ab[-]cdefghijk", "%40[][ab-]%s", "ab[-]", "cdefghijk", 2); +test_scanf ("ab12345cdefghijk", "ab%[^1-9]%s", "", "12345cdefghijk", 2); +test_scanf ("ab12345cdefghijk", "ab%3[^4-5]%s", "123", "45cdefghijk", 2); + +print ("Ok\n"); + +exit (0); + + + diff --git a/libslang/src/test/stdio.sl b/libslang/src/test/stdio.sl new file mode 100644 index 0000000..470bd6f --- /dev/null +++ b/libslang/src/test/stdio.sl @@ -0,0 +1,180 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + + +print ("Testing stdio routines..."); + +define fopen_tmp_file (fileptr, mode) +{ + variable n; + variable file, fp; + variable fmt; + + @fileptr = NULL; + + fmt = "tmp-xxx.%03d"; % I need something that works on an 8+3 filesystem + + n = -1; + while (n < 999) + { + n++; + file = sprintf (fmt, n); + if (NULL != stat_file (file)) + continue; + + fp = fopen (file, mode); + if (fp != NULL) + { + @fileptr = file; + return fp; + } + } + failed ("Unable to open a tmp file"); +} + +define run_tests (some_text, read_fun, write_fun, length_fun) +{ + variable file, fp; + variable new_text, nbytes, len; + variable pos; + + fp = fopen_tmp_file (&file, "wb"); + + if (-1 == @write_fun (some_text, fp)) + failed (string (write_fun)); + + if (-1 == fclose (fp)) + failed ("fclose"); + + fp = fopen (file, "rb"); + if (fp == NULL) failed ("fopen existing"); + + len = @length_fun (some_text); + nbytes = @read_fun (&new_text, len, fp); + + if ((nbytes != len) + or (some_text != new_text)) + failed (string (read_fun)); + + if (-1 != @read_fun (&new_text, 1, fp)) + failed (string (read_fun) + " at EOF"); + + if (0 == feof (fp)) failed ("feof"); + + clearerr (fp); + if (feof (fp)) failed ("clearerr"); + + if (0 != fseek (fp, 0, SEEK_SET)) failed ("fseek"); + + nbytes = @read_fun (&new_text, len, fp); + + if ((nbytes != len) + or (some_text != new_text)) + failed (string (read_fun) + " after fseek"); + + + pos = ftell (fp); + if (pos == -1) failed ("ftell at EOF"); + + if (0 != fseek (fp, 0, SEEK_SET)) failed ("fseek"); + if (0 != ftell (fp)) failed ("ftell at BOF"); + if (0 != fseek (fp, pos, SEEK_CUR)) failed ("fseek to pos"); + + if (pos != ftell (fp)) failed ("ftell after fseek to pos"); + + if (feof (fp) != 0) failed ("feof after fseek to EOF"); + + () = fseek (fp, 0, SEEK_SET); + nbytes = fread (&new_text, Char_Type, 0, fp); + if (nbytes != 0) + failed ("fread for 0 bytes"); + + nbytes = fread (&new_text, Char_Type, len + 100, fp); + if (nbytes != len) + failed ("fread for 100 extra bytes"); + + if (-1 == fclose (fp)) failed ("fclose after tests"); + () = remove (file); + if (stat_file (file) != NULL) failed ("remove"); +} + +static define do_fgets (addr, nbytes, fp) +{ + return fgets (addr, fp); +} + +static define do_fread (addr, nbytes, fp) +{ + return fread (addr, UChar_Type, nbytes, fp); +} + +run_tests ("ABCDEFG", &do_fgets, &fputs, &strlen); +run_tests ("A\000BC\000\n\n\n", &do_fread, &fwrite, &bstrlen); + +define test_fread_fwrite (x) +{ + variable fp, file, str, n, m, y, type, ch; + + fp = fopen_tmp_file (&file, "w+b"); + + type = _typeof(x); + n = length (x); + if ((type == String_Type) or (type == BString_Type)) + { + type = UChar_Type; + n = bstrlen (x); + } + + if (n != fwrite (x, fp)) + failed ("test_fread_fwrite: fwrite"); + + if (-1 == fseek (fp, 0, SEEK_SET)) + failed ("test_fread_fwrite: fseek"); + + if (n != fread (&y, type, n, fp)) + failed ("test_fread_fwrite: fread"); + + if (length (where (y != x))) + failed ("test_fread_fwrite: fread failed to return: " + string(x)); + + if (-1 == fseek (fp, 0, SEEK_SET)) + failed ("test_fread_fwrite: fseek"); + + if (type == UChar_Type) + { + y = 0; + foreach (fp) using ("char") + { + ch = (); + if (ch != x[y]) + failed ("foreach using char: %S != %S", ch, x[y]); + y++; + } + if (y != n) + failed ("foreach using char 2"); + } + + () = fclose (fp); + + if (-1 == remove (file)) + failed ("remove:" + errno_string(errno)); + if (stat_file (file) != NULL) failed ("remove"); +} + +test_fread_fwrite (""); +test_fread_fwrite ("hello"); +test_fread_fwrite ("hel\0\0lo"); +test_fread_fwrite (Integer_Type[0]); +test_fread_fwrite ([1:10]); +#ifexists Double_Type +test_fread_fwrite (3.17); +test_fread_fwrite ([1:10:0.01]); +#endif +#ifexists Complex_Type +test_fread_fwrite (Complex_Type[50] + 3 + 2i); +test_fread_fwrite (2i+3); +test_fread_fwrite ([2i+3, 7i+1]); +#endif + +print ("Ok\n"); + +exit (0); diff --git a/libslang/src/test/strops.sl b/libslang/src/test/strops.sl new file mode 100644 index 0000000..8669ba3 --- /dev/null +++ b/libslang/src/test/strops.sl @@ -0,0 +1,153 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing string functions..."); + +variable s; + +s = strcompress (" \t \tA\n\ntest\t", " \t\n"); +if (s != "A test") failed ("strcompress"); + +s = " \t hello world\n\t"; +if ("hello world" != strtrim (s)) failed ("strtrim"); +if ("hello world\n\t" != strtrim_beg (s)) failed ("strtrim_beg"); +if (" \t hello world" != strtrim_end (s)) failed ("strtrim_beg"); + +if ("hello wor" != strtrim (s, " \t\nld")) failed ("strtrim with whitespace"); + +if ("" != strcat ("", "")) + failed ("strcat 0"); +if ("1" != strcat ("", "1")) + failed ("strcat 1"); + +if ("abcdefg" != strcat ("a", "b", "c", "d", "e", "f", "g")) failed ("strcat"); +if ("abcdefg" != strcat ("abcdefg")) failed ("strcat 2"); + +if ((strtok (s)[0] != "hello") + or (strtok(s)[1] != "world") + or (strtok (s, "^a-z")[0] != "hello") + or (strtok (s, "^a-z")[1] != "world") + or (2 != length (strtok (s))) + or (2 != length (strtok (s, "^a-z")))) failed ("strtok"); + +define test_create_delimited_string () +{ + variable n = (); + variable args = __pop_args (_NARGS - 3); + variable delim = (); + variable eresult = (); + variable result; + + result = create_delimited_string (delim, __push_args (args), n); + if (eresult != result) + failed ("create_delimited_string: expected: %s, got: %s", + eresult, result); + + if (n) + result = strjoin ([__push_args (args)], delim); + else + result = strjoin (String_Type[0], delim); + + if (eresult != result) + failed ("strjoin: expected: %s, got: %s", + eresult, result); +} + + +test_create_delimited_string ("aXXbXXcXXdXXe", + "XX", + "a", "b", "c", "d", "e", + 5); + + +test_create_delimited_string ("", "", "", 1); +test_create_delimited_string ("a", ",", "a", 1); +test_create_delimited_string (",", ",", "", "", 2); +test_create_delimited_string (",,", ",", "", "", "", 3); +test_create_delimited_string ("", "XXX", 0); + +static define test_strtrans (s, from, to, ans) +{ + variable s1 = strtrans (s, from, to); + if (ans != s1) + failed ("strtrans(%s, %s, %s) --> %s", s, from, to, s1); +} + +test_strtrans ("hello world", "^a-zA-Z", "X", "helloXworld"); +test_strtrans ("hello", "", "xxxx", "hello"); +test_strtrans ("hello", "l", "", "heo"); +test_strtrans ("hello", "helo", "abcd", "abccd"); +test_strtrans ("hello", "hl", "X", "XeXXo"); +test_strtrans ("", "hl", "X", ""); +test_strtrans ("hello", "a-z", "A-Z", "HELLO"); +test_strtrans ("hello", "a-mn-z", "A-MN-Z", "HELLO"); +test_strtrans ("abcdefg", "a-z", "Z-A", "ZYXWVUT"); +test_strtrans ("hejklo", "k-l", "L-L---", "hejL-o"); +test_strtrans ("hello", "he", "-+", "-+llo"); +test_strtrans ("hello", "", "", "hello"); +test_strtrans ("hello", "helo", "", ""); +test_strtrans ("hello", "o", "", "hell"); +test_strtrans ("hello", "hlo", "", "e"); +test_strtrans ("", "hlo", "", ""); +test_strtrans ("HeLLo", "A-Ze", "", "o"); +test_strtrans ("HeLLo", "^A-Z", "", "HLL"); + +define test_str_replace (a, b, c, result, n) +{ + variable new; + variable m; + + (new, m) = strreplace (a, b, c, n); + + if (new != result) + failed ("strreplace (%s, %s, %s, %d) ==> %s", a, b, c, n, new); + + if (n == 1) + { + n = str_replace (a, b, c); + !if (n) a; + new = (); + if (new != result) + failed ("str_replace (%s, %s, %s) ==> %s", a, b, c, new); + } +} + +test_str_replace ("a", "b", "x", "a", 1); +test_str_replace ("a", "b", "x", "a", -1); +test_str_replace ("a", "b", "x", "a", -10); +test_str_replace ("a", "b", "x", "a", 10); +test_str_replace ("a", "b", "x", "a", 0); +test_str_replace ("blafoofbarfoobar", "", "xyyy", "blafoofbarfoobar", 0); +test_str_replace ("blafoofbarfoobar", "", "xyyy", "blafoofbarfoobar", 1); +test_str_replace ("blafoofbarfoobar", "", "xyyy", "blafoofbarfoobar", -1); +test_str_replace ("blafoofbarfoobar", "", "xyyy", "blafoofbarfoobar", -10); + +test_str_replace ("blafoofbarfoobar", "foo", "XY", "blafoofbarfoobar", 0); +test_str_replace ("blafoofbarfoobar", "foo", "XY", "blaXYfbarfoobar", 1); +test_str_replace ("blafoofbarfoobar", "foo", "XY", "blaXYfbarXYbar", 2); +test_str_replace ("blafoofbarfoobar", "foo", "XY", "blaXYfbarXYbar", 10); +test_str_replace ("blafoofbarfoobar", "foo", "XY", "blafoofbarXYbar", -1); +test_str_replace ("blafoofbarfoobar", "foo", "XY", "blaXYfbarXYbar", -2); +test_str_replace ("blafoofbarfoobar", "r", "", "blafoofbarfoobar", 0); +test_str_replace ("blafoofbarfoobar", "r", "", "blafoofbafoobar", 1); +test_str_replace ("blafoofbarfoobar", "r", "", "blafoofbafooba", 2); +test_str_replace ("blafoofbarfoobar", "r", "", "blafoofbarfooba", -1); +test_str_replace ("blafoofbarfoobar", "r", "", "blafoofbafooba", -2); +test_str_replace ("bla", "bla", "", "", -2); +test_str_replace ("bla", "bla", "foo", "foo", -2); +test_str_replace ("bla", "bla", "foo", "foo", 1); + +define test_strcat () +{ + % This test generates a combined byte-code. It is used for leak checking + variable a = "hello"; + variable b = "world"; + loop (20) + { + variable c = a + b; + a = c; + } +} + + +print ("Ok\n"); +exit (0); diff --git a/libslang/src/test/struct.sl b/libslang/src/test/struct.sl new file mode 100644 index 0000000..003f3e7 --- /dev/null +++ b/libslang/src/test/struct.sl @@ -0,0 +1,144 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing structures ..."); + +variable S = struct +{ + a, b, c +}; + +S.a = "a"; +S.b = "b"; +S.c = "c"; + +variable U = @Struct_Type ("a", "b", "c"); +variable abc = get_struct_field_names (U); +if ((abc[0] != "a") + or (abc[1] != "b") + or (abc[2] != "c")) + failed ("@Struct_Type"); + +abc = ["a", "b", "c"]; +U = @Struct_Type (abc); +if (length (where (abc != get_struct_field_names (U)))) + failed ("@Struct_Type([abc])"); + +variable T = @S; + +if (S.a != T.a) failed ("Unable to copy via @S"); +if (S.b != T.b) failed ("Unable to copy via @S"); +if (S.c != T.c) failed ("Unable to copy via @S"); + +T.a = "XXX"; +if (T.a == S.a) failed ("Unable to copy via @S"); + +set_struct_fields (T, 1, 2, "three"); +if ((T.c != "three") or (T.a != 1) or (T.b != 2)) + failed ("set_struct_fields"); + +T.a++; +T.a += 3; +T.a -= 20; +if (T.a != -15) + failed ("structure arithmetic"); + +T.c = S; +S.a = T; + +if (T != T.c.a) + failed ("Unable to create a circular list"); + +typedef struct +{ + TT_x, TT_y +} +TT; + +T = @TT; +if (typeof (T) != TT) + failed ("typeof(T)"); +if (0 == is_struct_type (T)) + failed ("is_struct_type"); +S = typecast (T, Struct_Type); +if (typeof (S) != Struct_Type) + failed ("typecast"); + +% C structures + +S = get_c_struct (); +if ((typeof (S.h) != Short_Type) + or (typeof (S.l) != Long_Type) + or (typeof (S.b) != Char_Type)) + failed ("get_c_struct field types"); + +static define print_struct(s) +{ + foreach (get_struct_field_names (s)) + { + variable f = (); + vmessage ("S.%s = %S", f, get_struct_field (s, f)); + } +} + + +#ifexists Complex_Type +S.z = 1+2i; +#endif +S.a = [1:10]; +#ifexists Double_Type +S.d = PI; +#endif +S.s = "foobar"; +S.ro_str = "FOO"; + +loop (10) + set_c_struct (S); + +loop (10) + T = get_c_struct (); + +%print_struct (T); + +if ((not __eqs(S.a, T.a)) +#ifexists Complex_Type + or (S.z != T.z) +#endif +#ifexists Double_Type + or (S.d != T.d) +#endif + or (T.ro_str != "read-only")) + failed ("C Struct"); + +loop (10) + get_c_struct_via_ref (&T); + +%print_struct (T); + +if ((not __eqs(S.a, T.a)) +#ifexists Complex_Type + or (S.z != T.z) +#endif +#ifexists Double_Type + or (S.d != T.d) +#endif + or (T.ro_str != "read-only")) + failed ("C Struct"); + +static define count_args () +{ + if (_NARGS != 0) + failed ("foreach using with NULL"); +} +static define test_foreach_using_with_null (s) +{ + foreach (s) using ("next") + { + s = (); + } + count_args (); +} +test_foreach_using_with_null (NULL); +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/syntax.sl b/libslang/src/test/syntax.sl new file mode 100644 index 0000000..6321eb9 --- /dev/null +++ b/libslang/src/test/syntax.sl @@ -0,0 +1,142 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing syntax ..."); + +if (0x12 != test_char_return (0x12)) failed ("test_char_return"); +if (0x1234h != test_short_return (0x1234h)) failed ("test_short_return"); +if (0x1234 != test_int_return (0x1234)) failed ("test_int_return"); +if (0x12345678L != test_long_return (0x12345678L)) failed ("test_long_return"); +% if (1.2e34f != test_float_return (1.2e34f)) failed ("test_float_return"); +#ifexists Double_Type +if (1.2e34 != test_double_return (1.2e34)) failed ("test_double_return"); +#endif + +static define static_xxx () +{ + return "xxx"; +} + +private define private_yyy () +{ + return "yyy"; +} + +public define public_zzz () +{ + return "zzz"; +} + +if (is_defined ("static_xxx") or "xxx" != static_xxx ()) + failed ("static_xxx"); +if (is_defined ("private_yyy") or "yyy" != private_yyy ()) + failed ("private_yyy"); +if (not is_defined ("public_zzz") or "zzz" != public_zzz ()) + failed ("public_xxx"); + +variable XXX = 1; +static define xxx () +{ + variable XXX = 2; + if (XXX != 2) failed ("local variable XXX"); +} + +xxx (); +if (XXX != 1) failed ("global variable XXX"); +if (1) +{ + if (orelse + {0} + {0} + {0} + {0} + ) + failed ("orelse"); +} + + +!if (orelse + {0} + {0} + {0} + {1}) failed ("not orelse"); + +_auto_declare = 1; +XXX_auto_declared = 1; + +if (&XXX_auto_declared != __get_reference ("XXX_auto_declared")) + failed ("__get_reference"); + +if (0 == __is_initialized (&XXX_auto_declared)) + failed ("__is_initialized"); +() = __tmp (XXX_auto_declared); +if (__is_initialized (&XXX_auto_declared)) + failed ("__is_initialized __tmp"); +XXX_auto_declared = "xxx"; +__uninitialize (&XXX_auto_declared); +if (__is_initialized (&XXX_auto_declared)) + failed ("__is_initialized __uninitialize"); + +static define test_uninitialize () +{ + variable x; + if (__is_initialized (&x)) + failed ("__is_initialized x"); + x = 3; + !if (__is_initialized (&x)) + failed ("__is_initialized x=3"); + if (3 != __tmp (x)) + failed ("__tmp return value"); + if (__is_initialized (&x)) + failed ("__tmp x"); + x = 4; + __uninitialize (&x); + if (__is_initialized (&x)) + failed ("__uninitialize x"); +} + +test_uninitialize (); + +static define check_args (n) +{ + if (n + 1 != _NARGS) + failed ("check_args %d", n); + _pop_n (_NARGS-1); +} + +static define nitems (n) +{ + loop (n) 1; +} + +check_args (1, 1); +check_args (1,2,2); +check_args (nitems(3), nitems(5), 8); +static variable X = [1:10]; +% X[3]++ produces nothing +check_args (nitems (3), check_args(nitems(4), X[3]++, 4, X[3]+=X[2], 5), 3); + +static define check_no_args () +{ + if (_NARGS != 0) + failed ("check_no_args"); +} + +% This failed in previous versions because abs was not treated as a function +% call. +if (abs (1) > 0) + check_no_args (); + +define check_tmp_optim () +{ + variable a = [1:10:1.0]; + variable b = a*0.0; + if ((a[0] != 1.0) or (__eqs(a,b))) + failed ("__tmp optimization: a[0] = %f", a[0]); +} + +check_tmp_optim (); + +print ("Ok\n"); + +exit (0); + diff --git a/libslang/src/test/template.sl b/libslang/src/test/template.sl new file mode 100644 index 0000000..f63c750 --- /dev/null +++ b/libslang/src/test/template.sl @@ -0,0 +1,10 @@ +_debug_info = 1; () = evalfile ("inc.sl"); + +print ("Testing XXXXX ..."); + +% Tests go here.... + +print ("Ok\n"); + +exit (0); + |