// Condition # estimator for triangular matrix
SEXP R_PDTRCON(SEXP TYPE, SEXP UPLO, SEXP DIAG, SEXP N, SEXP A, SEXP DESCA)
{
R_INIT;
double* work;
double tmp;
int* iwork;
int lwork, liwork, info = 0;
int IJ = 1, in1 = -1;
SEXP RET;
newRvec(RET, 2, "dbl");
// workspace query and allocate work vectors
pdtrcon_(CHARPT(TYPE, 0), CHARPT(UPLO, 0), CHARPT(DIAG, 0),
INTP(N), DBLP(A), &IJ, &IJ, INTP(DESCA), DBLP(RET),
&tmp, &in1, &liwork, &in1, &info);
lwork = (int) tmp;
work = malloc(lwork * sizeof(*work));
iwork = malloc(liwork * sizeof(*iwork));
// compute inverse of condition number
info = 0;
pdtrcon_(CHARPT(TYPE, 0), CHARPT(UPLO, 0), CHARPT(DIAG, 0),
INTP(N), DBLP(A), &IJ, &IJ, INTP(DESCA), DBLP(RET),
work, &lwork, iwork, &liwork, &info);
DBL(RET, 1) = (double) info;
free(work);
free(iwork);
R_END;
return RET;
}
extern "C" SEXP c_rthgini(SEXP x, SEXP mu, SEXP unbiased_, SEXP nthreads)
{
const int unbiased = INTEGER(unbiased_)[0];
const int n = LENGTH(x);
SEXP gini;
PROTECT(gini = allocVector(REALSXP, 1));
RTH_GEN_NTHREADS(nthreads);
thrust::device_vector<double> dx(REAL(x), REAL(x)+n);
thrust::sort(dx.begin(), dx.end());
thrust::counting_iterator<int> begin(0);
thrust::counting_iterator<int> end = begin + n;
thrust::plus<flouble> binop;
DBL(gini) = (double) thrust::transform_reduce(begin, end, compute_gini(n, dx.begin()), (flouble) 0., binop);
if (unbiased)
DBL(gini) = DBL(gini) / (n*(n-1)*DBL(mu));
else
DBL(gini) = DBL(gini) / (n*n*DBL(mu));
return gini;
}
SEXP R_convert_dense_to_csr(SEXP x)
{
R_INIT;
SEXP data, row_ptr, col_ind;
SEXP R_list, R_list_names;
const int m = nrows(x), n = ncols(x);
int i, j;
int row_ptr_len;
int sparsity, density;
int ct = 0, rct = 0, first;
sparsity = sparse_count_zeros_withrows(m, n, &row_ptr_len, REAL(x));
density = m*n - sparsity;
newRvec(data, density, "dbl");
newRvec(col_ind, density, "int");
newRvec(row_ptr, m+1, "int");
for (i=0; i<m; i++)
{
first = true;
for (j=0; j<n; j++)
{
if (MatDBL(x, i, j) > 0.0)
{
DBL(data, ct) = MatDBL(x, i, j);
INT(col_ind, ct) = j+1;
ct++;
if (first == true)
{
INT(row_ptr, rct) = ct;
first = false;
rct++;
}
}
}
if (first == true)
{
INT(row_ptr, rct) = ct+1;
rct++;
}
}
INT(row_ptr, m) = ct+1;
R_list_names = make_list_names(3, "Data", "row_ptr", "col_ind");
R_list = make_list(R_list_names, 3, data, row_ptr, col_ind);
R_END;
return R_list;
}
SEXP R_convert_csr_to_dense(SEXP dim, SEXP data, SEXP row_ptr, SEXP col_ind)
{
R_INIT;
int i, j;
int c = 0, r = 0, diff;
const int m = INT(dim, 0), n = INT(dim, 1);
SEXP dense_mat;
// Initialize
newRmat(dense_mat, m, n, "dbl");
for (j=0; j<n; j++)
{
for (i=0; i<m; i++)
MatDBL(dense_mat, i, j) = 0.0;
}
// This is disgusting
i = 0;
while (r < m && INT(row_ptr, r) < INT(row_ptr, m))
{
diff = INT(row_ptr, r+1) - INT(row_ptr, r);
if (diff == 0)
goto increment;
else
{
while (diff)
{
j = INT(col_ind, c)-1;
MatDBL(dense_mat, i, j) = DBL(data, c);
c++; // hehehe
diff--;
}
}
increment:
r++;
i++;
}
R_END;
return dense_mat;
}
static void
dump_imm_data(struct tgsi_iterate_context *iter,
union tgsi_immediate_data *data,
unsigned num_tokens,
unsigned data_type)
{
struct dump_ctx *ctx = (struct dump_ctx *)iter;
unsigned i ;
TXT( " {" );
assert( num_tokens <= 4 );
for (i = 0; i < num_tokens; i++) {
switch (data_type) {
case TGSI_IMM_FLOAT64: {
union di d;
d.ui = data[i].Uint | (uint64_t)data[i+1].Uint << 32;
DBL( d.d );
i++;
break;
}
case TGSI_IMM_FLOAT32:
if (ctx->dump_float_as_hex)
HFLT( data[i].Float );
else
FLT( data[i].Float );
break;
case TGSI_IMM_UINT32:
UID(data[i].Uint);
break;
case TGSI_IMM_INT32:
SID(data[i].Int);
break;
default:
assert( 0 );
}
if (i < num_tokens - 1)
TXT( ", " );
}
TXT( "}" );
}
// Condition # estimator for general matrix
SEXP R_PDGECON(SEXP TYPE, SEXP M, SEXP N, SEXP A, SEXP DESCA)
{
R_INIT;
int IJ = 1;
double* cpA;
int info = 0;
const int m = nrows(A);
const int n = ncols(A);
SEXP RET;
newRvec(RET, 2, "dbl"); // RET = {cond_num, info}
cpA = malloc(m*n * sizeof(*cpA));
memcpy(cpA, DBLP(A), m*n*sizeof(*cpA));
// compute inverse of condition number
condnum_(CHARPT(TYPE, 0), INTP(M), INTP(N), cpA, &IJ, &IJ, INTP(DESCA), DBLP(RET), &info);
DBL(RET, 1) = (double) info;
free(cpA);
R_END;
return RET;
}
DBL POVFPU_RunDefault(FUNCTION fn)
{
StackFrame *pstack = POVFPU_Current_Context->pstackbase;
DBL *dblstack = POVFPU_Current_Context->dblstackbase;
unsigned int maxdblstacksize = POVFPU_Current_Context->maxdblstacksize;
DBL r0, r1, r2, r3, r4, r5, r6, r7;
Instruction *program = NULL;
unsigned int k = 0;
unsigned int pc = 0;
unsigned int ccr = 0;
unsigned int sp = 0;
unsigned int psp = 0;
#if (SUPPORT_INTEGER_INSTRUCTIONS == 1)
POV_LONG iA, iB, itemp;
#endif
#if (DEBUG_DEFAULTCPU == 1)
COUNTER instr;
Long_To_Counter(POVFPU_Functions[fn].fn.program_size, instr);
Add_Counter(stats[Ray_Function_VM_Instruction_Est], stats[Ray_Function_VM_Instruction_Est], instr);
#endif
Increase_Counter(stats[Ray_Function_VM_Calls]);
program = POVFPU_Functions[fn].fn.program;
while(true)
{
k = GET_K(program[pc]);
switch(GET_OP(program[pc]))
{
OP_MATH_AOP(0,+); // add Rs, Rd
OP_MATH_AOP(1,-); // sub Rs, Rd
OP_MATH_AOP(2,*); // mul Rs, Rd
OP_MATH_AOP(3,/); // div Rs, Rd
OP_MOD_A(4); // mod Rs, Rd
OP_ASSIGN_ABOP(5,0,r0); // move R0, Rd
OP_ASSIGN_ABOP(5,1,r1); // move R1, Rd
OP_ASSIGN_ABOP(5,2,r2); // move R2, Rd
OP_ASSIGN_ABOP(5,3,r3); // move R3, Rd
OP_ASSIGN_ABOP(5,4,r4); // move R4, Rd
OP_ASSIGN_ABOP(5,5,r5); // move R5, Rd
OP_ASSIGN_ABOP(5,6,r6); // move R6, Rd
OP_ASSIGN_ABOP(5,7,r7); // move R7, Rd
OP_CMP_ABC(6,0,r0); // cmp R0, Rd
OP_CMP_ABC(6,1,r1); // cmp R1, Rd
OP_CMP_ABC(6,2,r2); // cmp R2, Rd
OP_CMP_ABC(6,3,r3); // cmp R3, Rd
OP_CMP_ABC(6,4,r4); // cmp R4, Rd
OP_CMP_ABC(6,5,r5); // cmp R5, Rd
OP_CMP_ABC(6,6,r6); // cmp R6, Rd
OP_CMP_ABC(6,7,r7); // cmp R7, Rd
OP_ASSIGN_ABOP(7,0,-r0); // neg R0, Rd
OP_ASSIGN_ABOP(7,1,-r1); // neg R1, Rd
OP_ASSIGN_ABOP(7,2,-r2); // neg R2, Rd
OP_ASSIGN_ABOP(7,3,-r3); // neg R3, Rd
OP_ASSIGN_ABOP(7,4,-r4); // neg R4, Rd
OP_ASSIGN_ABOP(7,5,-r5); // neg R5, Rd
OP_ASSIGN_ABOP(7,6,-r6); // neg R6, Rd
OP_ASSIGN_ABOP(7,7,-r7); // neg R7, Rd
OP_ABS_A(8); // abs Rs, Rd
OP_MATH_ABCOP(9,0,POVFPU_Consts[k],+); // addi k, Rd
OP_MATH_ABCOP(9,1,POVFPU_Consts[k],-); // subi k, Rd
OP_MATH_ABCOP(9,2,POVFPU_Consts[k],*); // muli k, Rd
OP_MATH_ABCOP(9,3,POVFPU_Consts[k],/); // divi k, Rd
OP_MOD_ABC(9,4,POVFPU_Consts[k]); // modi k, Rd
OP_ASSIGN_ABOP(9,5,POVFPU_Consts[k]); // loadi k, Rd
OP_CMP_ABC(9,6,POVFPU_Consts[k]); // cmpi k, Rs
OP_ASSIGN_ABOP(10,0,ccr == 1); // seq Rd
OP_ASSIGN_ABOP(10,1,ccr != 1); // sne Rd
OP_ASSIGN_ABOP(10,2,ccr == 2); // slt Rd
OP_ASSIGN_ABOP(10,3,ccr >= 1); // sle Rd
OP_ASSIGN_ABOP(10,4,ccr == 0); // sgt Rd
OP_ASSIGN_ABOP(10,5,ccr <= 1); // sge Rd
OP_MATH_ABCOP(10,6,0.0,==); // teq Rd
OP_MATH_ABCOP(10,7,0.0,!=); // tne Rd
OP_ASSIGN_ABOP(11,0,POVFPU_Globals[k]); // load 0(k), Rd
OP_ASSIGN_ABOP(11,1,dblstack[sp+k]); // load SP(k), Rd
OP_REVASSIGN_ABOP(12,0,POVFPU_Globals[k]); // store Rs, 0(k)
OP_REVASSIGN_ABOP(12,1,dblstack[sp+k]); // store Rs, SP(k)
OP_SPECIAL(13,0,0,if(ccr == 1) pc = k - 1); // beq k
OP_SPECIAL(13,1,0,if(ccr != 1) pc = k - 1); // bne k
OP_SPECIAL(13,2,0,if(ccr == 2) pc = k - 1); // blt k
OP_SPECIAL(13,3,0,if(ccr >= 1) pc = k - 1); // ble k
OP_SPECIAL(13,4,0,if(ccr == 0) pc = k - 1); // bgt k
OP_SPECIAL(13,5,0,if(ccr <= 1) pc = k - 1); // bge k
OP_XCC_ABOP(14,0,==); // xeq Rd
OP_XCC_ABOP(14,1,!=); // xne Rd
OP_XCC_ABOP(14,2,<); // xlt Rd
OP_XCC_ABOP(14,3,<=); // xle Rd
OP_XCC_ABOP(14,4,>); // xgt Rd
OP_XCC_ABOP(14,5,>=); // xge Rd
OP_SPECIAL(14,6,0,if((r0 == 0.0) && (r0 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R0
OP_SPECIAL(14,6,1,if((r0 == 0.0) && (r1 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R1
OP_SPECIAL(14,6,2,if((r0 == 0.0) && (r2 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R2
OP_SPECIAL(14,6,3,if((r0 == 0.0) && (r3 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R3
OP_SPECIAL(14,6,4,if((r0 == 0.0) && (r4 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R4
OP_SPECIAL(14,6,5,if((r0 == 0.0) && (r5 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R5
OP_SPECIAL(14,6,6,if((r0 == 0.0) && (r6 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R6
OP_SPECIAL(14,6,7,if((r0 == 0.0) && (r7 == 0.0)) POVFPU_Exception(fn)); // xdz R0, R7
OP_SPECIAL_CASE(15,0,0) // jsr k
pstack[psp].pc = pc;
pstack[psp].fn = fn;
psp++;
if(psp >= MAX_CALL_STACK_SIZE)
POVFPU_Exception(fn, "Maximum function evaluation recursion level reached.");
pc = k;
continue; // prevent increment of pc
OP_SPECIAL_CASE(15,0,1) // jmp k
pc = k;
continue; // prevent increment of pc
OP_SPECIAL_CASE(15,0,2) // rts
if(psp == 0)
return r0;
psp--;
pc = pstack[psp].pc; // old position, will be incremented
fn = pstack[psp].fn;
program = POVFPU_Functions[fn].fn.program;
break;
OP_SPECIAL_CASE(15,0,3) // call k
pstack[psp].pc = pc;
pstack[psp].fn = fn;
psp++;
if(psp >= MAX_CALL_STACK_SIZE)
POVFPU_Exception(fn, "Maximum function evaluation recursion level reached.");
fn = k;
program = POVFPU_Functions[fn].fn.program;
pc = 0;
continue; // prevent increment of pc
OP_SPECIAL_CASE(15,0,4) // sys1 k
r0 = POVFPU_Sys1Table[k](r0);
break;
OP_SPECIAL_CASE(15,0,5) // sys2 k
r0 = POVFPU_Sys2Table[k](r0,r1);
break;
OP_SPECIAL_CASE(15,0,6) // trap k
r0 = POVFPU_TrapTable[k].fn(&dblstack[sp], fn);
maxdblstacksize = POVFPU_Current_Context->maxdblstacksize;
dblstack = POVFPU_Current_Context->dblstackbase;
break;
OP_SPECIAL_CASE(15,0,7) // traps k
POVFPU_TrapSTable[k].fn(&dblstack[sp], fn, sp);
maxdblstacksize = POVFPU_Current_Context->maxdblstacksize;
dblstack = POVFPU_Current_Context->dblstackbase;
break;
OP_SPECIAL_CASE(15,1,0) // grow k
if((unsigned int)((unsigned int)sp + (unsigned int)k) >= (unsigned int)MAX_K)
{
POVFPU_Exception(fn, "Stack full. Possible infinite recursive function call.");
}
else if(sp + k >= maxdblstacksize)
{
maxdblstacksize = POVFPU_Current_Context->maxdblstacksize = POVFPU_Current_Context->maxdblstacksize + max(k + 1, (unsigned int)256);
dblstack = POVFPU_Current_Context->dblstackbase = (DBL *)POV_REALLOC(dblstack, sizeof(DBL) * maxdblstacksize, "fn: stack");
}
break;
OP_SPECIAL_CASE(15,1,1) // push k
if(sp + k >= maxdblstacksize)
POVFPU_Exception(fn, "Function evaluation stack overflow.");
sp += k;
break;
OP_SPECIAL_CASE(15,1,2) // pop k
if(k > sp)
POVFPU_Exception(fn, "Function evaluation stack underflow.");
sp -= k;
break;
#if (SUPPORT_INTEGER_INSTRUCTIONS == 1)
OP_SPECIAL_CASE(15,1,3) // iconv
iA = POV_LONG(r0);
break;
OP_SPECIAL_CASE(15,1,4) // fconv
r0 = DBL(iA);
break;
OP_SPECIAL_CASE(15,1,5) // reserved
POVFPU_Exception(fn, "Internal error - reserved function VM opcode found!");
break;
OP_INT_MATH_ABOP(15,32,+); // add s, d
OP_INT_MATH_ABOP(15,33,-); // sub s, d
OP_INT_MATH_ABOP(15,34,*); // mul s, d
OP_INT_SPECIAL(15,35,0,iA = iA / iB); // div B, A
OP_INT_SPECIAL(15,35,1,iB = iB / iA); // div A, B
OP_INT_SPECIAL(15,35,2,iA = iA % iB); // mod B, A
OP_INT_SPECIAL(15,35,3,iB = iB % iA); // mod A, B
OP_INT_SPECIAL(15,36,0,ccr = (((iB > iA) & 1) << 1) | ((iB == iA) & 1)); // cmp B, A
OP_INT_SPECIAL(15,36,1,ccr = (((iA > iB) & 1) << 1) | ((iA == iB) & 1)); // cmp A, B
OP_INT_SPECIAL(15,36,2,itemp = iA; iA = iB; iB = itemp); // exg A, B
OP_INT_SPECIAL(15,36,3,iA = iB = 0); // clr A, B
OP_INT_SPECIAL(15,37,0,iA = 0); // clr A
OP_INT_SPECIAL(15,37,1,iB = 0); // clr B
OP_INT_SPECIAL(15,37,2,iA = iB); // move B, A
OP_INT_SPECIAL(15,37,3,iB = iA); // move A, B
OP_INT_SPECIAL(15,38,0,iA = -iA); // neg A
OP_INT_SPECIAL(15,38,1,iB = -iB); // neg B
OP_INT_SPECIAL(15,38,2,iA = abs(iA)); // abs A
OP_INT_SPECIAL(15,38,3,iB = abs(iB)); // abs B
OP_INT_SPECIAL(15,39,0,iA = iA + k); // addi k, A
OP_INT_SPECIAL(15,39,1,iB = iB + k); // addi k, B
OP_INT_SPECIAL(15,39,2,iA = iA - k); // subi k, A
OP_INT_SPECIAL(15,39,3,iB = iB - k); // subi k, B
OP_INT_MATH_SHIFT_ABOP(15,40,<<,POV_LONG); // asl s, d
OP_INT_MATH_SHIFT_ABOP(15,41,>>,POV_LONG); // asr s, d
OP_INT_MATH_SHIFT_ABOP(15,42,<<,POV_ULONG); // lsl s, d
OP_INT_MATH_SHIFT_ABOP(15,43,>>,POV_ULONG); // lsr s, d
OP_INT_MATH_ABOP(15,44,&); // and s, d
OP_INT_MATH_ABOP(15,45,|); // or s, d
OP_INT_MATH_ABOP(15,46,^); // xor s, d
OP_INT_SPECIAL(15,47,0,iA = !iA); // not A, A
OP_INT_SPECIAL(15,47,1,iA = !iB); // not B, A
OP_INT_SPECIAL(15,47,2,iB = !iA); // not A, B
OP_INT_SPECIAL(15,47,3,iB = !iB); // not B, B
OP_INT_SPECIAL(15,48,0,iA = k); // loadi A
OP_INT_SPECIAL(15,48,1,iB = k); // loadi B
OP_INT_SPECIAL(15,48,2,iA = (iA << 16) | k);// ldhi A
OP_INT_SPECIAL(15,48,3,iB = (iB << 16) | k);// ldhi B
OP_INT_SPECIAL(15,49,0,iA = max(POV_LONG(k), iA)); // max k, A
OP_INT_SPECIAL(15,49,1,iB = max(POV_LONG(k), iB)); // max k, B
OP_INT_SPECIAL(15,49,2,iA = min(POV_LONG(k), iA)); // min k, A
OP_INT_SPECIAL(15,49,3,iB = min(POV_LONG(k), iB)); // min k, B
OP_INT_SPECIAL(15,50,0,iA = (POV_LONG(iA) << k)); // asl k, A
OP_INT_SPECIAL(15,50,1,iB = (POV_LONG(iB) >> k)); // asr k, B
OP_INT_SPECIAL(15,50,2,iA = (POV_ULONG(iA) << k)); // lsl k, A
OP_INT_SPECIAL(15,50,3,iB = (POV_ULONG(iB) >> k)); // lsr k, B
#endif
default: // nop
break;
}
pc++;
}
#if (DEBUG_DEFAULTCPU == 1)
printf("Registers\n");
printf("=========\n");
printf("PC = %d\n", (int)pc);
printf("CCR = %x\n", (int)ccr);
printf("R0 = %8f R4 = %8f\n", (float)r0, (float)r4);
printf("R1 = %8f R5 = %8f\n", (float)r1, (float)r5);
printf("R2 = %8f R6 = %8f\n", (float)r2, (float)r6);
printf("R3 = %8f R7 = %8f\n", (float)r3, (float)r7);
#endif
}
// The beast
SEXP R_PDSYEVX(SEXP JOBZ, SEXP RANGE, SEXP N, SEXP A, SEXP DESCA, SEXP VL, SEXP VU, SEXP IL, SEXP IU, SEXP ABSTOL, SEXP ORFAC)
{
R_INIT;
char uplo = 'U';
int IJ = 1;
int i;
int m, nz;
int lwork, liwork, info;
int descz[9], ldm[2], blacs[5];
int tmp_liwork;
int *iwork, *ifail, *iclustr;
double tmp_lwork;
double *work;
double *w, *z, *gap;
double *a;
SEXP RET, RET_NAMES, W, Z, M;
// grid and local information
pdims_(INTEGER(DESCA), ldm, blacs);
ldm[0] = nrows(A);//nonzero(ldm[0]);
ldm[1] = ncols(A);//nonzero(ldm[1]);
// Setup for the setup
for (i=0; i<9; i++)
descz[i] = INT(DESCA, i);
w = (double*) R_alloc(INT(N), sizeof(double));
z = (double*) R_alloc(ldm[0]*ldm[1], sizeof(double));
gap = (double*) R_alloc(blacs[1]*blacs[2], sizeof(double));
a = (double*) R_alloc(ldm[0]*ldm[1], sizeof(double));
memcpy(a, DBLP(A), nrows(A)*ncols(A)*sizeof(double));
ifail = (int*) R_alloc(INT(N, 0), sizeof(int));
iclustr = (int*) R_alloc(2*blacs[1]*blacs[2], sizeof(int));
// Allocate local workspace
lwork = -1;
liwork = -1;
info = 0;
pdsyevx_(CHARPT(JOBZ, 0), CHARPT(RANGE, 0), &uplo,
INTP(N), a, &IJ, &IJ, INTP(DESCA),
DBLP(VL), DBLP(VU), INTP(IL), INTP(IU),
DBLP(ABSTOL), &m, &nz, w,
DBLP(ORFAC), z, &IJ, &IJ, descz,
&tmp_lwork, &lwork, &tmp_liwork, &liwork,
ifail, iclustr, gap, &info);
lwork = nonzero( ((int) tmp_lwork) );
work = (double*) R_alloc(lwork, sizeof(double));
liwork = nonzero(tmp_liwork);
iwork = (int*) R_alloc(liwork, sizeof(int));
// Compute eigenvalues
m = 0;
info = 0;
pdsyevx_(CHARPT(JOBZ, 0), CHARPT(RANGE, 0), &uplo,
INTP(N), a, &IJ, &IJ, INTP(DESCA),
DBLP(VL), DBLP(VU), INTP(IL), INTP(IU),
DBLP(ABSTOL), &m, &nz, w,
DBLP(ORFAC), z, &IJ, &IJ, descz,
work, &lwork, iwork, &liwork,
ifail, iclustr, gap, &info);
newRvec(W, m, "dbl");
for (i=0; i<m; i++)
DBL(W, i) = w[i];
/* SEXP IFAIL;*/
/* PROTECT(IFAIL = allocVector(INTSXP, m));*/
/* for (i=0; i<m; i++)*/
/* INTEGER(IFAIL)[0] = ifail[i];*/
// Manage the return
if (CHARPT(JOBZ, 0)[0] == 'N') // Only eigenvalues are computed
{
RET_NAMES = make_list_names(1, "values");
RET = make_list(RET_NAMES, 1, W);
}
else // eigenvalues + eigenvectors
{
newRmat(Z, ldm[0], ldm[1], "dbl");
for (i=0; i<ldm[0]*ldm[1]; i++)
DBL(Z, i) = z[i];
newRvec(M, 1, "int");
INT(M, 0) = m;
RET_NAMES = make_list_names(3, "values", "vectors", "m");
RET = make_list(RET_NAMES, 3, W, Z, M);
}
R_END;
return RET;
}
int main()
{
fs_hash_init(FS_HASH_UMAC);
int passes = 0;
int fails = 0;
#if 1
#define DUMP(t) printf("%lld %s\n", fs_c.xsd_##t, #t);
DUMP(double);
DUMP(float);
DUMP(decimal);
DUMP(integer);
DUMP(boolean);
#endif
#define TEST1(f, a, x) printf("[%s] ", fs_value_equal(f(NULL, a), x) ? "PASS" : "FAIL"); printf("%s(", #f); fs_value_print(a); printf(") = "); fs_value_print(f(NULL, a)); printf("\n"); if (!fs_value_equal(f(NULL, a), x)) { fails++; printf(" should have been "); fs_value_print(x); printf("\n"); } else { passes++; }
#define TEST2(f, a, b, x) printf("[%s] ", fs_value_equal(f(NULL, a, b), x) ? "PASS" : "FAIL"); printf("%s(", #f); fs_value_print(a); printf(", "); fs_value_print(b); printf(") = "); fs_value_print(f(NULL, a, b)); printf("\n"); if (!fs_value_equal(f(NULL, a, b), x)) { fails++; printf(" should have been "); fs_value_print(x); printf("\n"); } else { passes++; }
#define TEST3(f, a, b, c, x) printf("[%s] ", fs_value_equal(f(NULL, a, b, c), x) ? "PASS" : "FAIL"); printf("%s(", #f); fs_value_print(a); printf(", "); fs_value_print(b); printf(", "); fs_value_print(c); printf(") = "); fs_value_print(f(NULL, a, b, c)); printf("\n"); if (!fs_value_equal(f(NULL, a, b, c), x)) { fails++; printf(" should have been "); fs_value_print(x); printf("\n"); } else { passes++; }
#define URI(x) fs_value_uri(x)
#define RID(x) fs_value_rid(x)
#define BND(x) fs_value_rid(0x8000000000000000LL | x)
#define STR(x) fs_value_string(x)
#define PLN(x) fs_value_plain(x)
#define PLN_L(x, l) fs_value_plain_with_lang(x, l)
#define DBL(x) fs_value_double(x)
#define FLT(x) fs_value_float(x)
#define DEC(x) fs_value_decimal(x)
#define INT(x) fs_value_integer(x)
#define BLN(x) fs_value_boolean(x)
#define DAT(x) fs_value_datetime(x)
#define DAT_S(x) fs_value_datetime_from_string(x)
#define ERR() fs_value_error(FS_ERROR_INVALID_TYPE, NULL)
#define BLK() fs_value_blank()
TEST2(fn_numeric_add, BLK(), BLK(), ERR());
TEST2(fn_numeric_add, INT(1), URI("test:"), ERR());
TEST2(fn_numeric_add, STR("2"), INT(3), ERR());
TEST2(fn_numeric_add, INT(2), INT(3), INT(5));
TEST2(fn_numeric_add, DEC(2.5), DEC(-1), DEC(1.5));
TEST2(fn_numeric_add, DEC(-2.5), DEC(-1.5), DEC(-4));
TEST2(fn_numeric_subtract, INT(2), INT(3), INT(-1));
TEST2(fn_numeric_add, DBL(1), INT(2), DBL(3));
TEST2(fn_numeric_add, FLT(17000), INT(2), FLT(17002));
TEST2(fn_numeric_subtract, FLT(17000), INT(2), FLT(16998));
TEST2(fn_numeric_subtract, DEC(17000.5), INT(2), DEC(16998.5));
TEST2(fn_numeric_multiply, URI("http://example.com/"), INT(2), ERR());
TEST2(fn_numeric_multiply, DEC(3.5), INT(2), DEC(7));
TEST2(fn_numeric_multiply, DEC(35), DBL(-0.1), DBL(-3.5));
TEST2(fn_numeric_multiply, INT(1), FLT(23), FLT(23));
TEST2(fn_numeric_multiply, INT(10), INT(23), INT(230));
TEST2(fn_numeric_divide, INT(9), URI("http://example.org/"), ERR());
TEST2(fn_numeric_divide, INT(9), INT(2), DEC(4.5));
TEST2(fn_numeric_divide, INT(-9), INT(2), DEC(-4.5));
TEST2(fn_numeric_divide, INT(-9), INT(-2), DEC(4.5));
TEST2(fn_numeric_divide, DBL(90), FLT(10), DBL(9));
TEST2(fn_numeric_divide, FLT(99), FLT(-10), FLT(-9.9));
TEST2(fn_equal, URI("http://example.com/"), DEC(23), BLN(0));
TEST2(fn_equal, URI("http://example.com/"), URI("http://example.com/"), BLN(1));
TEST2(fn_equal, INT(23), DEC(23), BLN(1));
TEST2(fn_equal, fs_value_decimal_from_string("-23.0"), DEC(-23), BLN(1));
TEST2(fn_equal, STR("foo"), PLN("foo"), BLN(0));
TEST2(fn_equal, PLN("foo"), PLN("foo"), BLN(1));
TEST2(fn_equal, BLN(0), BLN(0), BLN(1));
TEST2(fn_greater_than, STR("BBB"), STR("AAA"), BLN(1));
TEST2(fn_greater_than, PLN("BBB"), PLN("AAA"), BLN(1));
TEST2(fn_greater_than, PLN("AAA"), PLN("BBB"), BLN(0));
TEST2(fn_less_than, PLN("BBB"), PLN("AAA"), BLN(0));
TEST2(fn_less_than, PLN("AAA"), PLN("BBB"), BLN(1));
TEST2(fn_less_than, INT(20), INT(15), BLN(0));
TEST2(fn_numeric_equal, INT(23), INT(23), BLN(1));
TEST2(fn_numeric_equal, INT(23), DEC(23), BLN(1));
TEST2(fn_numeric_equal, INT(23), FLT(23), BLN(1));
TEST2(fn_numeric_equal, INT(23), DBL(23), BLN(1));
TEST2(fn_numeric_equal, fn_minus(NULL, INT(23)), DBL(-23), BLN(1));
TEST2(fn_datetime_equal, DAT(1000), DAT(1000), BLN(1));
TEST2(fn_datetime_equal, DAT(time(NULL)), DAT(1000), BLN(0));
TEST2(fn_numeric_less_than, INT(0), DBL(23), BLN(1));
TEST2(fn_numeric_less_than, INT(23), DBL(23), BLN(0));
TEST2(fn_numeric_less_than, DBL(22.99999), INT(23), BLN(1));
TEST2(fn_numeric_less_than, DEC(-18.51), DEC(-18.5), BLN(1));
TEST2(fn_numeric_less_than, DBL(-18.51), DBL(-18.5), BLN(1));
TEST2(fn_numeric_less_than, DEC(-18.5), DEC(-18.51), BLN(0));
TEST2(fn_numeric_less_than, DBL(-18.5), DBL(-18.51), BLN(0));
TEST2(fn_numeric_greater_than, DEC(-121.98882), DEC(-121.739856), BLN(0));
TEST2(fn_numeric_greater_than, DEC(37.67473), DEC(37.677954), BLN(0));
TEST2(fn_numeric_greater_than, INT(0), DBL(23), BLN(0));
TEST2(fn_numeric_greater_than, INT(23), DBL(23), BLN(0));
TEST2(fn_numeric_greater_than, DBL(22.99999), INT(23), BLN(0));
TEST2(fn_numeric_greater_than, DEC(-18.51), DEC(-18.5), BLN(0));
TEST2(fn_numeric_greater_than, DBL(-18.51), DBL(-18.5), BLN(0));
TEST2(fn_numeric_greater_than, DEC(-18.5), DEC(-18.51), BLN(1));
TEST2(fn_numeric_greater_than, DBL(-18.5), DBL(-18.51), BLN(1));
TEST2(fn_logical_and, BLN(1), BLN(0), BLN(0));
TEST2(fn_logical_and, BLN(1), BLN(1), BLN(1));
TEST2(fn_logical_and, INT(0), INT(1), BLN(0));
TEST2(fn_logical_and, INT(1), INT(1), BLN(1));
TEST2(fn_logical_and, STR("true"), INT(1), BLN(1));
TEST2(fn_logical_and, STR("false"), INT(1), BLN(1));
TEST2(fn_logical_and, INT(1), ERR(), ERR());
TEST2(fn_logical_and, ERR(), INT(1), ERR());
TEST2(fn_logical_and, INT(0), ERR(), BLN(0));
TEST2(fn_logical_and, ERR(), INT(0), BLN(0));
TEST2(fn_logical_and, ERR(), ERR(), ERR());
TEST2(fn_logical_or, BLN(1), BLN(0), BLN(1));
TEST2(fn_logical_or, BLN(1), BLN(1), BLN(1));
TEST2(fn_logical_or, INT(0), INT(1), BLN(1));
TEST2(fn_logical_or, INT(1), INT(1), BLN(1));
TEST2(fn_logical_or, STR("true"), INT(32), BLN(1));
TEST2(fn_logical_or, STR("false"), INT(1), BLN(1));
TEST2(fn_logical_or, INT(1), ERR(), BLN(1));
TEST2(fn_logical_or, ERR(), INT(1), BLN(1));
TEST2(fn_logical_or, INT(0), ERR(), ERR());
TEST2(fn_logical_or, ERR(), INT(0), ERR());
TEST2(fn_logical_or, ERR(), ERR(), ERR());
TEST2(fn_compare, STR("AAA"), STR("BBB"), INT(-1));
TEST2(fn_compare, STR("BBB"), STR("BBB"), INT(0));
TEST2(fn_compare, STR("BBB"), STR("AAA"), INT(1));
TEST2(fn_compare, PLN("BBB"), PLN("AAA"), INT(1));
TEST2(fn_compare, STR("BBB"), PLN("BBB"), ERR());
TEST2(fn_compare, STR("http://example.com/"), URI("http://example.com/"), ERR());
TEST2(fn_compare, URI("http://example.com/"), URI("http://example.com/"), ERR());
TEST2(fn_compare, INT(1), PLN("BBB"), ERR());
TEST3(fn_matches, PLN("foobar"), PLN("foo"), BLK(), BLN(1));
TEST3(fn_matches, PLN("foobar"), PLN("^foo"), BLK(), BLN(1));
TEST3(fn_matches, PLN("foobar"), PLN("bar$"), BLK(), BLN(1));
TEST3(fn_matches, PLN("foobar"), PLN("BAR"), STR("i"), BLN(1));
TEST3(fn_matches, PLN("foobar"), PLN("^FOOB[AO]R$"), STR("i"), BLN(1));
TEST3(fn_matches, PLN("foobar"), PLN("^bar"), BLK(), BLN(0));
TEST3(fn_matches, PLN("foobar"), PLN("^foo$"), BLK(), BLN(0));
TEST3(fn_matches, PLN("foobar"), PLN("foo bar"), PLN("x"), BLN(1));
TEST3(fn_matches, INT(23), PLN("foo bar"), PLN("x"), ERR());
TEST3(fn_matches, PLN("foobar"), DAT(1000), PLN("x"), ERR());
TEST1(fn_bound, URI("http://example.com/"), BLN(1));
TEST1(fn_bound, STR("http"), BLN(1));
TEST1(fn_bound, PLN(""), BLN(1));
TEST1(fn_bound, BND(100), BLN(1));
TEST1(fn_bound, RID(FS_RID_NULL), BLN(0));
TEST1(fn_is_blank, URI("http://example.com/"), BLN(0));
TEST1(fn_is_blank, STR("http"), BLN(0));
TEST1(fn_is_blank, PLN(""), BLN(0));
TEST1(fn_is_blank, BND(100), BLN(1));
TEST1(fn_is_blank, RID(FS_RID_NULL), BLN(0));
TEST1(fn_is_iri, URI("http://example.com/"), BLN(1));
TEST1(fn_is_iri, STR("http"), BLN(0));
TEST1(fn_is_iri, PLN(""), BLN(0));
TEST1(fn_is_iri, BND(100), BLN(0));
TEST1(fn_is_iri, RID(FS_RID_NULL), BLN(0));
TEST1(fn_is_literal, URI("http://example.com/"), BLN(0));
TEST1(fn_is_literal, STR("http"), BLN(1));
TEST1(fn_is_literal, PLN(""), BLN(1));
TEST1(fn_is_literal, BND(100), BLN(0));
TEST1(fn_is_literal, RID(FS_RID_NULL), BLN(0));
TEST1(fn_str, URI("http://example.com/"), PLN("http://example.com/"));
TEST1(fn_str, STR("http"), PLN("http"));
TEST1(fn_str, PLN(""), PLN(""));
TEST1(fn_str, BLN(1), PLN("true"));
TEST1(fn_str, INT(1), PLN("1"));
TEST1(fn_str, FLT(11.1), PLN("11.100000"));
TEST1(fn_str, DBL(11.1), PLN("11.100000"));
TEST1(fn_str, DEC(23), PLN("23.000000"));
TEST1(fn_str, DAT(1000), PLN("1970-01-01T00:16:40"));
TEST1(fn_str, BND(100), ERR());
TEST1(fn_str, RID(FS_RID_NULL), ERR());
TEST1(fn_lang, PLN("foo"), PLN(""));
TEST1(fn_lang, STR("foo"), PLN(""));
TEST1(fn_lang, PLN_L("foo", "en"), PLN("en"));
TEST1(fn_lang, PLN_L("foo", ""), PLN(""));
TEST1(fn_lang, BLN(1), PLN(""));
TEST1(fn_lang, INT(1), PLN(""));
TEST1(fn_lang, DEC(1.1), PLN(""));
TEST1(fn_lang, FLT(1.1), PLN(""));
TEST1(fn_lang, DBL(1.1), PLN(""));
TEST1(fn_lang, URI("http://example.org/"), ERR());
TEST1(fn_datatype, PLN("foo"), ERR());
TEST1(fn_datatype, STR("foo"), URI(XSD_STRING));
TEST1(fn_datatype, PLN_L("foo", "en"), ERR());
TEST1(fn_datatype, PLN_L("foo", ""), ERR());
TEST1(fn_datatype, BLN(1), URI(XSD_BOOLEAN));
TEST1(fn_datatype, INT(1), URI(XSD_INTEGER));
TEST1(fn_datatype, DEC(1.1), URI(XSD_DECIMAL));
TEST1(fn_datatype, FLT(1.1), URI(XSD_FLOAT));
TEST1(fn_datatype, DBL(1.1), URI(XSD_DOUBLE));
TEST1(fn_datatype, DAT(1000), URI(XSD_DATETIME));
TEST1(fn_datatype, URI("http://example.org/"), ERR());
TEST2(fn_equal, DAT_S("1975-01-07"), DAT(158284800), BLN(1));
TEST2(fn_equal, DAT_S("1975-01-07T00:00:01"), DAT(158284801), BLN(1));
TEST2(fn_equal, DAT_S("1975-01-07T01:00:01+0000"), DAT(158288401), BLN(1));
TEST2(fn_equal, DAT_S("1975-01-07T01:00:01-0900"), DAT(158320801), BLN(1));
TEST2(fn_cast, DBL(2.1), URI(XSD_INTEGER), INT(2));
TEST2(fn_cast, PLN("2.23"), URI(XSD_DOUBLE), DBL(2.23));
TEST2(fn_cast, PLN_L("2.23", "en"), URI(XSD_DOUBLE), DBL(2.23));
TEST2(fn_cast, STR("2.23"), URI(XSD_DOUBLE), DBL(2.23));
TEST2(fn_cast, URI("http://example.com/"), URI(XSD_STRING), ERR());
TEST2(fn_cast, DAT(1000), URI(XSD_STRING), STR("1970-01-01T00:16:40"));
TEST2(fn_cast, STR("1975-01-07T01:00:01-0900"), URI(XSD_DATETIME), DAT(158320801));
printf("\n=== pass %d, fail %d\n", passes, fails);
if (fails) {
return 1;
}
return 0;
}
const gchar *str;
gboolean alpha;
gboolean fail;
const gdouble r;
const gdouble g;
const gdouble b;
const gdouble a;
} ColorSample;
static const ColorSample samples[] =
{
/* sample alpha fail red green blue alpha */
{ "#000000", FALSE, FALSE, 0.0, 0.0, 0.0, 0.0 },
{ "#FFff00", FALSE, FALSE, 1.0, 1.0, 0.0, 0.0 },
{ "#6495ed", FALSE, FALSE, DBL(100), DBL(149), DBL(237), 0.0 },
{ "#fff", FALSE, FALSE, 1.0, 1.0, 1.0, 0.0 },
{ "#64649595eded", FALSE, FALSE, 1.0, 1.0, 0.0, 0.0 },
{ "rgb(0,0,0)", FALSE, FALSE, 0.0, 0.0, 0.0, 0.0 },
{ "rgb(100,149,237)", FALSE, FALSE, DBL(100), DBL(149), DBL(237), 0.0 },
{ "rgba(100%,0,100%,0.5)", TRUE, FALSE, 255.0, 0.0, 255.0, 0.5 },
{ "rgba(100%,0,100%,0.5)", FALSE, TRUE, 255.0, 0.0, 255.0, 0.5 },
{ "rgb(100%,149,20%)", FALSE, FALSE, 1.0, DBL(149), 0.2, 0.0 },
{ "rgb(100%,149,20%)", TRUE, TRUE, 1.0, DBL(149), 0.2, 0.0 },
{ "rgb(foobar)", FALSE, TRUE, 0.0, 0.0, 0.0, 0.0 },
{ "rgb(100,149,237", FALSE, TRUE, 0.0, 0.0, 0.0, 0.0 },
{ "rED", FALSE, FALSE, 1.0, 0.0, 0.0, 0.0 },
{ "cornflowerblue", FALSE, FALSE, DBL(100), DBL(149), DBL(237), 0.0 },
{ " red", FALSE, FALSE, 1.0, 0.0, 0.0, 0.0 },
{ "red ", FALSE, FALSE, 1.0, 0.0, 0.0, 0.0 },
{ "red", TRUE, TRUE, 1.0, 0.0, 0.0, 0.0 },
