The R Project SVN R

Rev

Rev 45446 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 45446 Rev 46214
Line 327... Line 327...
327 
    break;
 327 
    break;
328 
    case LGLSXP:
 328 
    case LGLSXP:
329 
    case INTSXP:
 329 
    case INTSXP:
330 
	n = LENGTH(s);
 330 
	n = LENGTH(s);
331 
	iptr = INTEGER(s);
 331 
	iptr = INTEGER(s);
- 
 
 332 
	if(!naok)
332 
	for (i = 0 ; i < n ; i++) {
 333 
	    for (i = 0 ; i < n ; i++)
333 
	    if(!naok && iptr[i] == NA_INTEGER)
 334 
		if(iptr[i] == NA_INTEGER)
334 
		error(_("NAs in foreign function call (arg %d)"), narg);
 335 
		    error(_("NAs in foreign function call (arg %d)"), narg);
335 
	}
 - 
 
336 
	if (dup) {
 336 
	if (dup) {
337 
	    iptr = (int*)R_alloc(n, sizeof(int));
 337 
	    iptr = (int*)R_alloc(n, sizeof(int));
338 
	    for (i = 0 ; i < n ; i++)
 338 
	    for (i = 0 ; i < n ; i++)
339 
		iptr[i] = INTEGER(s)[i];
 339 
		iptr[i] = INTEGER(s)[i];
340 
	}
 340 
	}
341 
	return (void*)iptr;
 341 
	return (void*)iptr;
342 
	break;
 342 
	break;
343 
    case REALSXP:
 343 
    case REALSXP:
344 
	n = LENGTH(s);
 344 
	n = LENGTH(s);
345 
	rptr = REAL(s);
 345 
	rptr = REAL(s);
- 
 
 346 
	if(!naok)
346 
	for (i = 0 ; i < n ; i++) {
 347 
	    for (i = 0 ; i < n ; i++)
347 
	    if(!naok && !R_FINITE(rptr[i]))
 348 
		if(!R_FINITE(rptr[i]))
348 
		error(_("NA/NaN/Inf in foreign function call (arg %d)"), narg);
 349 
		    error(_("NA/NaN/Inf in foreign function call (arg %d)"), narg);
349 
	}
 - 
 
350 
	if (dup) {
 350 
	if (dup) {
351 
	    if(asLogical(getAttrib(s, CSingSymbol)) == 1) {
 351 
	    if(asLogical(getAttrib(s, CSingSymbol)) == 1) {
352 
		sptr = (float*)R_alloc(n, sizeof(float));
 352 
		sptr = (float*)R_alloc(n, sizeof(float));
353 
		for (i = 0 ; i < n ; i++)
 353 
		for (i = 0 ; i < n ; i++)
354 
		    sptr[i] = (float) REAL(s)[i];
 354 
		    sptr[i] = (float) REAL(s)[i];
Line 363... Line 363...
363 
	    return (void*)rptr;
 363 
	    return (void*)rptr;
364 
	break;
 364 
	break;
365 
    case CPLXSXP:
 365 
    case CPLXSXP:
366 
	n = LENGTH(s);
 366 
	n = LENGTH(s);
367 
	zptr = COMPLEX(s);
 367 
	zptr = COMPLEX(s);
- 
 
 368 
	if(!naok)
368 
	for (i = 0 ; i < n ; i++) {
 369 
	    for (i = 0 ; i < n ; i++)
369 
	    if(!naok && (!R_FINITE(zptr[i].r) || !R_FINITE(zptr[i].i)))
 370 
		if(!R_FINITE(zptr[i].r) || !R_FINITE(zptr[i].i))
370 
		error(_("complex NA/NaN/Inf in foreign function call (arg %d)"),
 371 
		    error(_("complex NA/NaN/Inf in foreign function call (arg %d)"), narg);
371 
		      narg);
 - 
 
372 
	}
 - 
 
373 
	if (dup) {
 372 
	if (dup) {
374 
	    zptr = (Rcomplex*)R_alloc(n, sizeof(Rcomplex));
 373 
	    zptr = (Rcomplex*)R_alloc(n, sizeof(Rcomplex));
375 
	    for (i = 0 ; i < n ; i++)
 374 
	    for (i = 0 ; i < n ; i++)
376 
		zptr[i] = COMPLEX(s)[i];
 375 
		zptr[i] = COMPLEX(s)[i];
377 
	}
 376 
	}