Esempi in C++ (Cpp) per R_getClassDef

Esempio n. 1

File: math.c Progetto: yizhang/riot

SEXP math_dbvector(SEXP x, SEXP op)
{
	SEXP ans, rinfo, rtablename, rptr;

	rdbVector *xinfo = getInfo(x);

	MYSQL *sqlconn = NULL;
	int success = connectToLocalDB(&sqlconn);

	if(!success || sqlconn == NULL)
	{
		error("cannot connect to local db\n");
		return R_NilValue;
	}

	PROTECT(ans = R_do_new_object(R_getClassDef("dbvector")));
	PROTECT(rinfo = allocVector(RAWSXP,sizeof(rdbVector)));
	rdbVector *vec = (rdbVector*)RAW(rinfo);
	vec->tableName = malloc(MAX_TABLE_NAME*sizeof(char));
	initRDBVector(&vec, 0, 0);

	if (strcmp(CHAR(asChar(op)), "sin") == 0)
	{
		switch(xinfo->sxp_type)
		{
			case INTSXP:
			case REALSXP:
				performNumericSin(sqlconn, xinfo, vec);
				break;
			case CPLXSXP:
				performComplexSin(sqlconn, xinfo, vec);
				break;
			default:
				free(vec->tableName);
				mysql_close(sqlconn);
				UNPROTECT(2);
				error("wrong type");
		}
	}
	else if (strcmp(CHAR(asChar(op)), "cos") == 0)
	{
		switch(xinfo->sxp_type)
		{
			case INTSXP:
			case REALSXP:
				performNumericCos(sqlconn, xinfo, vec);
				break;
			case CPLXSXP:
				performComplexCos(sqlconn, xinfo, vec);
				break;
			default:
				free(vec->tableName);
				mysql_close(sqlconn);
				UNPROTECT(2);
				error("wrong type");
		}
	}
	else
	{
		free(vec->tableName);
		mysql_close(sqlconn);
		UNPROTECT(2);
		error("wrong type");
	}

	PROTECT(rtablename= allocVector(STRSXP, 1));
	SET_STRING_ELT(rtablename, 0, mkChar(vec->tableName));
	R_do_slot_assign(ans, install("tablename"), rtablename);
	R_do_slot_assign(ans, install("info"), rinfo);
	/* register finalizer */
	rdbVector *ptr = malloc(sizeof(rdbVector));
	*ptr = *vec;
	PROTECT(rptr = R_MakeExternalPtr(ptr, R_NilValue, R_NilValue));
	R_do_slot_assign(ans, install("ext"), rptr);
	R_RegisterCFinalizerEx(rptr, rdbVectorFinalizer, TRUE);

	UNPROTECT(4);
	return ans;
}

Esempio n. 2

File: ErrorValue.cpp Progetto: arunaryan/OG-RStats

SEXP RErrorValue::FromValue (const com_opengamma_language_Value *pValue) {
	if (!pValue) {
		LOGWARN (TEXT ("NULL pointer"));
		return R_NilValue;
	}
	if (!pValue->_errorValue) {
		LOGWARN (TEXT ("NULL error value"));
		return R_NilValue;
	}
	LOGDEBUG (TEXT ("Error ") << *pValue->_errorValue);
	SEXP cls = R_getClassDef (R_ERRORVALUE_CLASS);
	if (cls == R_NilValue) {
		LOGFATAL (ERR_R_FUNCTION);
		return R_NilValue;
	}
	PROTECT (cls);
	SEXP obj = R_do_new_object (cls);
	if (obj == R_NilValue) {
		LOGFATAL (ERR_R_FUNCTION);
		UNPROTECT (1);
		return R_NilValue;
	}
	PROTECT (obj);
	SEXP v = allocVector (INTSXP, 1);
	if (v == R_NilValue) {
		LOGFATAL (ERR_R_FUNCTION)
		UNPROTECT (2);
		return R_NilValue;
	}
	PROTECT (v);
	*INTEGER(v) = *pValue->_errorValue;
	SEXP f = mkString (R_ERRORVALUE_ERROR);
	if (f == R_NilValue) {
		LOGFATAL (ERR_R_FUNCTION);
		UNPROTECT (3);
		return R_NilValue;
	}
	PROTECT (f);
	R_do_slot_assign (obj, f, v);
	if (pValue->_intValue) {
		LOGDEBUG (TEXT ("Int ") << *pValue->_intValue);
		v = allocVector (INTSXP, 1);
		if (v != R_NilValue) {
			PROTECT (v);
			*INTEGER(v) = *pValue->_intValue;
			f = mkString (R_ERRORVALUE_INT);
			if (f && (f != R_NilValue)) {
				PROTECT (f);
				R_do_slot_assign (obj, f, v);
				UNPROTECT (2);
			} else {
				LOGERROR (ERR_R_FUNCTION);
				UNPROTECT (1);
			}
		} else {
			LOGERROR (ERR_R_FUNCTION);
		}
	}
	if (pValue->_stringValue) {
		LOGDEBUG (TEXT ("String ") << pValue->_stringValue);
#ifdef _UNICODE
		char *pszStringValue = WideToAsciiDup (pValue->_stringValue);
		if (pszStringValue) {
			v = mkString (pszStringValue);
			free (pszStringValue);
		} else {
			LOGFATAL (ERR_MEMORY);
			return R_NilValue;
		}
#else /* ifdef _UNICODE */
		v = mkString (pValue->_stringValue);
#endif /* ifdef _UNICODE */
		if (v != R_NilValue) {
			PROTECT (v);
			f = mkString (R_ERRORVALUE_STRING);
			if (f != R_NilValue) {
				PROTECT (f);
				R_do_slot_assign (obj, f, v);
				UNPROTECT (2);
			} else {
				LOGERROR (ERR_R_FUNCTION);
			}
		} else {
			LOGERROR (ERR_R_FUNCTION);
		}
	}
	TCHAR *psz = CError::ToString (pValue);
	if (!psz) {
		LOGFATAL (ERR_MEMORY);
		UNPROTECT (4);
		return R_NilValue;
	}
	LOGDEBUG (TEXT ("toString ") << psz);
#ifdef _UNICODE
	char *pszAscii = WideToAsciiDup (psz);
	if (pszAscii) {
		v = mkString (pszAscii);
		free (pszAscii);
	} else {
		LOGFATAL (ERR_MEMORY);
		UNPROTECT (4);
		return R_NilValue;
	}
#else /* ifdef _UNICODE */
	v = mkString (psz);
#endif /* ifdef _UNICODE */
	delete psz;
	if (v != R_NilValue) {
		PROTECT (v);
		f = mkString (R_ERRORVALUE_TOSTRING);
		if (f != R_NilValue) {
			PROTECT (f);
			R_do_slot_assign (obj, f, v);
			UNPROTECT (6);
		} else {
			LOGERROR (ERR_R_FUNCTION);
			UNPROTECT (5);
		}
	} else {
		LOGERROR (ERR_R_FUNCTION);
		UNPROTECT (4);
	}
	return obj;
}