コード例 #1
0
ファイル: guile-jvm.c プロジェクト: fenghaitao/Harpoon
SCM
abort_test (SCM name, char *exception)
{
  (*env)->ExceptionClear (env);
  return gh_list (name,
		  gh_symbol2scm ("ERROR"), 
		  gh_str02scm (exception),
		  SCM_UNDEFINED);
}
コード例 #2
0
ファイル: ccl.c プロジェクト: saniv/freecraft-ale-clone
/**
**	Default title-screen.
**
**	@param title	SCM title. (nil reports only)
**
**	@return		Current title screen.
*/
local SCM CclTitleScreen(SCM title)
{
    if( !gh_null_p(title) ) {
	if( TitleScreen ) {
	    free(TitleScreen);
	    TitleScreen=NULL;
	}

	TitleScreen=gh_scm2newstr(title,NULL);
    } else {
	title=gh_str02scm(TitleScreen);
    }
    return title;
}
コード例 #3
0
ファイル: scm-gconf.c プロジェクト: BARGAN/gconf
SCM
gconf_value_to_scm(GConfValue* val)
{
  SCM retval = SCM_EOL;

  if (val == NULL)
    return SCM_EOL;
  
  switch (val->type)
    {
    case GCONF_VALUE_INVALID:
      /* EOL */
      break;
    case GCONF_VALUE_STRING:
      retval = gh_str02scm(gconf_value_get_string(val));
      break;
    case GCONF_VALUE_INT:
      retval = gh_int2scm(gconf_value_get_int(val));
      break;
    case GCONF_VALUE_FLOAT:
      retval = gh_double2scm(gconf_value_get_float(val));
      break;
    case GCONF_VALUE_BOOL:
      retval = gh_bool2scm(gconf_value_get_bool(val));
      break;
    case GCONF_VALUE_SCHEMA:
      /* FIXME this is more complicated, we need a smob or something */
      break;
    case GCONF_VALUE_LIST:
      /* FIXME This is complicated too... */
      break;
    case GCONF_VALUE_PAIR:
      retval = gh_cons(gconf_value_to_scm(gconf_value_get_car(val)),
                       gconf_value_to_scm(gconf_value_get_cdr(val)));
      break;
    default:
      g_warning("Unhandled type in %s", G_STRFUNC);
      break;
    }

  return retval;
}
コード例 #4
0
ファイル: guile-jvm.c プロジェクト: fenghaitao/Harpoon
SCM
handle_test_exception (jobject test_name_obj)
{
  jthrowable throwable;
  jclass object_class;
  jobject err_msg_obj;
  char *err_msg, *test_name;
  const char *utf;
  SCM result;
  jboolean is_copy;
  static jmethodID obj_toString_mid = NULL;

  throwable = (*env)->ExceptionOccurred (env);
  (*env)->ExceptionClear (env);

  if (obj_toString_mid == NULL)
    obj_toString_mid = (*env)->GetMethodID (env, 
					    (*env)->FindClass (env, 
							  "java/lang/Object"), 
					    "toString", 
					    "()Ljava/lang/String;");

  err_msg_obj = (*env)->CallObjectMethod (env, throwable, obj_toString_mid);

  utf = (*env)->GetStringUTFChars (env, err_msg_obj, &is_copy);
  err_msg = strdup (utf);
  (*env)->ReleaseStringUTFChars (env, err_msg_obj, utf);

  utf = (*env)->GetStringUTFChars (env, test_name_obj, &is_copy);
  test_name = strdup (utf);
  (*env)->ReleaseStringUTFChars (env, test_name_obj, utf);

  result = abort_test (gh_str02scm (test_name), err_msg);

  free (err_msg);
  free (test_name);

  return result;
}   
コード例 #5
0
ファイル: guile-jvm.c プロジェクト: fenghaitao/Harpoon
SCM
perform_test (SCM clazz_scm_name)
{
  char *clazz_name, *test_name, *result_name, *msg;
  const char *utf;
  jclass clazz;
  jmethodID mid;
  jobject test_obj, result_obj, test_name_obj, result_name_obj, msg_obj;
  jboolean is_copy;
  SCM scm_test_name, scm_result_name, scm_result_msg;

  clazz_name = gh_scm2newstr (clazz_scm_name, NULL);
  clazz = (*env)->FindClass (env, clazz_name);
  if (clazz == NULL)
    {
      SCM clazz_err = gh_str02scm (clazz_name);
      free (clazz_name);
      return abort_test (clazz_err, "Unable to find class");
    }

  mid = (*env)->GetMethodID (env, clazz, "<init>", "()V");
  test_obj = (*env)->NewObject (env, clazz, mid);

  if ((*env)->IsInstanceOf (env, test_obj, test_class) == JNI_FALSE)
    {
      SCM clazz_err = gh_str02scm (clazz_name);
      free (clazz_name);
      return abort_test (clazz_err, "Not an instanceof gnu.test.Test");
    }
  free (clazz_name);

  /* Call all the Java testing methods */
  test_name_obj = (*env)->CallObjectMethod (env, test_obj, test_name_mid);
  result_obj = (*env)->CallObjectMethod (env, test_obj, test_mid);

  /* Handle an exception if one occurred */
  if ((*env)->ExceptionOccurred (env))
      return handle_test_exception (test_name_obj);

  result_name_obj = (*env)->CallObjectMethod (env, result_obj, 
					      result_name_mid);
  msg_obj = (*env)->CallObjectMethod (env, result_obj, result_msg_mid);

  /* Grab all the C result messages */
  utf = (*env)->GetStringUTFChars (env, test_name_obj, &is_copy);
  test_name = strdup (utf);
  (*env)->ReleaseStringUTFChars (env, test_name_obj, utf);

  utf = (*env)->GetStringUTFChars (env, result_name_obj, &is_copy);
  result_name = strdup (utf);
  (*env)->ReleaseStringUTFChars (env, result_name_obj, utf);

  utf = (*env)->GetStringUTFChars (env, msg_obj, &is_copy);
  msg = strdup (utf);
  (*env)->ReleaseStringUTFChars (env, msg_obj, utf);

  /* Convert the C result messages to Scheme */
  scm_test_name = gh_str02scm (test_name);
  scm_result_name = gh_symbol2scm (result_name);
  scm_result_msg = gh_str02scm (msg);

  /* Free up the C result messages */
  free (test_name);
  free (result_name);
  free (msg);

  return gh_list (scm_test_name,
		  scm_result_name,
		  scm_result_msg,
		  SCM_UNDEFINED);
}
コード例 #6
0
ファイル: ccl.c プロジェクト: saniv/freecraft-ale-clone
/**
**	Clone library path.
**
**	@return		Current clone libray path.
*/
local SCM CclCloneLibraryPath(void)
{
    return gh_str02scm(CloneLibPath);
}
コード例 #7
0
ファイル: ccl.c プロジェクト: saniv/freecraft-ale-clone
/**
**	Clone library path.
**
**	@return		Current clone libray path.
*/
local SCM CclCloneLibraryPath(void)
{
    return gh_str02scm(CLONE_LIB_PATH);
}