The R Project SVN R

Rev

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

Rev 47366 Rev 47460
Line 578... Line 578...
578 
	s = (SEXP)p;
 578 
	s = (SEXP)p;
579 
    }
 579 
    }
580 
    return s;
 580 
    return s;
581 
}
 581 
}
582 
 
 582 
 
583 
#define THROW_REGISTRATION_TYPE_ERROR
 - 
 
584 
 
 - 
 
585 
#ifdef THROW_REGISTRATION_TYPE_ERROR
 - 
 
586 
static Rboolean
 583 
static Rboolean
587 
comparePrimitiveTypes(R_NativePrimitiveArgType type, SEXP s, Rboolean dup)
 584 
comparePrimitiveTypes(R_NativePrimitiveArgType type, SEXP s, Rboolean dup)
588 
{
 585 
{
589 
   if(type == ANYSXP || TYPEOF(s) == type)
 586 
   if(type == ANYSXP || TYPEOF(s) == type)
590 
      return(TRUE);
 587 
      return(TRUE);
Line 592... Line 589...
592 
   if(dup && type == SINGLESXP)
 589 
   if(dup && type == SINGLESXP)
593 
      return(asLogical(getAttrib(s, install("Csingle"))) == TRUE);
 590 
      return(asLogical(getAttrib(s, install("Csingle"))) == TRUE);
594 
 
 591 
 
595 
   return(FALSE);
 592 
   return(FALSE);
596 
}
 593 
}
597 
#endif /* end of THROW_REGISTRATION_TYPE_ERROR */
 - 
 
598 
 
 594 
 
599 
 
 595 
 
600 
/* Foreign Function Interface.  This code allows a user to call C */
 596 
/* Foreign Function Interface.  This code allows a user to call C */
601 
/* or Fortran code which is either statically or dynamically linked. */
 597 
/* or Fortran code which is either statically or dynamically linked. */
602 
 
 598 
 
Line 1693... Line 1689...
1693 
    /* once here, on the way into the call, and */
 1689 
    /* once here, on the way into the call, and */
1694 
    /* once below on the way out. */
 1690 
    /* once below on the way out. */
1695 
    cargs = (void**)R_alloc(nargs, sizeof(void*));
 1691 
    cargs = (void**)R_alloc(nargs, sizeof(void*));
1696 
    nargs = 0;
 1692 
    nargs = 0;
1697 
    for(pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
 1693 
    for(pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
1698 
#ifdef THROW_REGISTRATION_TYPE_ERROR
 - 
 
1699 
	if(checkTypes &&
 1694 
	if(checkTypes &&
1700 
	   !comparePrimitiveTypes(checkTypes[nargs], CAR(pargs), dup)) {
 1695 
	   !comparePrimitiveTypes(checkTypes[nargs], CAR(pargs), dup)) {
1701 
	    /* We can loop over all the arguments and report all the
 1696 
	    /* We can loop over all the arguments and report all the
1702 
	       erroneous ones, but then we would also want to avoid
 1697 
	       erroneous ones, but then we would also want to avoid
1703 
	       the conversions.  Also, in the future, we may just
 1698 
	       the conversions.  Also, in the future, we may just
Line 1707... Line 1702...
1707 
	       to return the correct value which is complicated by
 1702 
	       to return the correct value which is complicated by
1708 
	       dup, etc. */
 1703 
	       dup, etc. */
1709 
	    errorcall(call, _("Wrong type for argument %d in call to %s"),
 1704 
	    errorcall(call, _("Wrong type for argument %d in call to %s"),
1710 
		      nargs+1, symName);
 1705 
		      nargs+1, symName);
1711 
	}
 1706 
	}
1712 
#endif
 - 
 
1713 
	cargs[nargs] = RObjToCPtr(CAR(pargs), naok, dup, nargs + 1,
 1707 
	cargs[nargs] = RObjToCPtr(CAR(pargs), naok, dup, nargs + 1,
1714 
				  which, symName, argConverters + nargs,
 1708 
				  which, symName, argConverters + nargs,
1715 
				  checkTypes ? checkTypes[nargs] : 0,
 1709 
				  checkTypes ? checkTypes[nargs] : 0,
1716 
				  encname);
 1710 
				  encname);
1717 
#ifdef R_MEMORY_PROFILING
 1711 
#ifdef R_MEMORY_PROFILING