array.sl

一个C格式的脚本处理函数库源代码,可让你的C程序具有执行C格式的脚本文件

_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]], "")))