Merge branch 'ZackerySpytz-OCaml-allowexcept-test'

* ZackerySpytz-OCaml-allowexcept-test:
  [OCaml] Fix %allowexception
This commit is contained in:
William S Fulton 2019-01-31 07:11:49 +00:00
commit 3c8cfac27b
8 changed files with 20 additions and 50 deletions

View file

@ -14,7 +14,6 @@ top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
FAILING_CPP_TESTS = \
allowexcept \
allprotected \
apply_signed_char \
apply_strings \

View file

@ -0,0 +1,7 @@
open Swig
open Allowexcept
let _ =
assert (_global_variable '() = C_void);
assert (_Foo_static_member_variable '() = C_void)
;;

View file

@ -9,7 +9,6 @@ type _value = c_obj
%define %array_tmap_out(type,what,out_f)
%typemap(type) what [ANY] {
int i;
/* $*1_type */
$result = caml_array_new($1_dim0);
for( i = 0; i < $1_dim0; i++ ) {
caml_array_set($result,i,out_f($1[i]));
@ -20,7 +19,6 @@ type _value = c_obj
%define %array_tmap_in(type,what,in_f)
%typemap(type) what [ANY] {
int i;
/* $*1_type */
$1 = ($*1_type *)malloc( $1_size );
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = in_f(caml_array_nth($input,i));
@ -57,7 +55,6 @@ type _value = c_obj
%typemap(in) SWIGTYPE [] {
int i;
/* $*1_type */
$1 = new $*1_type [$1_dim0];
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = *(($*1_ltype *)
@ -69,7 +66,6 @@ type _value = c_obj
%typemap(in) SWIGTYPE [] {
int i;
/* $*1_type */
$1 = ($*1_type *)malloc( $1_size );
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = *(($*1_ltype)
@ -102,7 +98,6 @@ type _value = c_obj
%typemap(in) enum SWIGTYPE [] {
int i;
/* $*1_type */
$1 = ($*1_type *)malloc( $1_size );
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = ($type)

View file

@ -35,8 +35,8 @@ extern "C" {
SWIG_Cast (void *source, swig_type_info *source_type,
void **ptr, swig_type_info *dest_type)
{
if( !source ) { // Special case for NULL. This is a popular question
// for other modules on the list, so I want an easy way out...
if( !source ) { /* Special case for NULL. This is a popular question
for other modules on the list, so I want an easy way out... */
*ptr = 0;
return 0;
}

View file

@ -33,7 +33,7 @@ SWIGEXT {
#define caml_array_set swig_caml_array_set
// Adapted from memory.h and mlvalues.h
/* Adapted from memory.h and mlvalues.h */
#define SWIG_CAMLlocal1(x) \
caml_value_t x = 0; \

View file

@ -29,7 +29,6 @@ class wstring;
/* Overloading check */
%typemap(in) string {
/* %typemap(in) string */
if (caml_ptr_check($input))
$1.assign((char *)caml_ptr_val($input,0), caml_string_len($input));
else
@ -37,7 +36,6 @@ class wstring;
}
%typemap(in) const string & ($*1_ltype temp) {
/* %typemap(in) const string & */
if (caml_ptr_check($input)) {
temp.assign((char *)caml_ptr_val($input,0), caml_string_len($input));
$1 = &temp;
@ -47,7 +45,6 @@ class wstring;
}
%typemap(in) string & ($*1_ltype temp) {
/* %typemap(in) string & */
if (caml_ptr_check($input)) {
temp.assign((char *)caml_ptr_val($input,0), caml_string_len($input));
$1 = &temp;
@ -57,7 +54,6 @@ class wstring;
}
%typemap(in) string * ($*1_ltype *temp) {
/* %typemap(in) string * */
if (caml_ptr_check($input)) {
temp = new $*1_ltype((char *)caml_ptr_val($input,0), caml_string_len($input));
$1 = temp;
@ -71,22 +67,18 @@ class wstring;
}
%typemap(argout) string & {
/* %typemap(argout) string & */
swig_result = caml_list_append(swig_result,caml_val_string_len((*$1).c_str(), (*$1).size()));
}
%typemap(directorout) string {
/* %typemap(directorout) string */
$result.assign((char *)caml_ptr_val($input,0), caml_string_len($input));
}
%typemap(out) string {
/* %typemap(out) string */
$result = caml_val_string_len($1.c_str(),$1.size());
}
%typemap(out) string * {
/* %typemap(out) string * */
$result = caml_val_string_len((*$1).c_str(),(*$1).size());
}
}

View file

@ -28,38 +28,31 @@
}
%typemap(in) char *& (char *temp) {
/* %typemap(in) char *& */
temp = (char*)caml_val_ptr($1,$descriptor);
$1 = &temp;
}
%typemap(argout) char *& {
/* %typemap(argout) char *& */
swig_result = caml_list_append(swig_result,caml_val_string_len(*$1, strlen(*$1)));
}
%typemap(in) SWIGTYPE & {
/* %typemap(in) SWIGTYPE & */
$1 = ($ltype) caml_ptr_val($input,$1_descriptor);
}
%typemap(in) SWIGTYPE && {
/* %typemap(in) SWIGTYPE && */
$1 = ($ltype) caml_ptr_val($input,$1_descriptor);
}
%typemap(varin) SWIGTYPE & {
/* %typemap(varin) SWIGTYPE & */
$1 = *(($ltype) caml_ptr_val($input,$1_descriptor));
}
%typemap(varin) SWIGTYPE && {
/* %typemap(varin) SWIGTYPE && */
$1 = *(($ltype) caml_ptr_val($input,$1_descriptor));
}
%typemap(out) SWIGTYPE & {
/* %typemap(out) SWIGTYPE & */
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = caml_callback(*fromval,caml_val_ptr((void *) &$1,$1_descriptor));
@ -69,7 +62,6 @@
}
%typemap(out) SWIGTYPE && {
/* %typemap(out) SWIGTYPE && */
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = caml_callback(*fromval,caml_val_ptr((void *) &$1,$1_descriptor));
@ -117,7 +109,6 @@
#ifdef __cplusplus
%typemap(out) SWIGTYPE {
/* %typemap(out) SWIGTYPE */
$&1_ltype temp = new $ltype((const $1_ltype &) $1);
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
@ -130,7 +121,6 @@
#else
%typemap(out) SWIGTYPE {
/* %typemap(out) SWIGTYPE */
void *temp = calloc(1,sizeof($ltype));
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
memmove( temp, &$1, sizeof( $1_type ) );
@ -179,14 +169,12 @@
$result = C_TO_MZ($1);
}
%typemap(varout) C_NAME & {
/* %typemap(varout) C_NAME & (generic) */
$result = C_TO_MZ($1);
}
%typemap(argout) C_NAME *OUTPUT {
swig_result = caml_list_append(swig_result,C_TO_MZ((long)*$1));
}
%typemap(out) C_NAME & {
/* %typemap(out) C_NAME & (generic) */
$result = C_TO_MZ(*$1);
}
%typemap(argout) C_NAME & {
@ -247,15 +235,12 @@ SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
%define %char_ptr_in(how)
%typemap(how) char *, signed char *, unsigned char * {
/* %typemap(how) char * ... */
$1 = ($ltype)caml_string_val($input);
}
/* Again work around the empty array bound bug */
%typemap(how) char [ANY], signed char [ANY], unsigned char [ANY] {
/* %typemap(how) char [ANY] ... */
char *temp = caml_string_val($input);
strcpy((char *)$1,temp);
/* strncpy would be better but we might not have an array size */
}
%enddef
@ -283,11 +268,9 @@ SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
%define %swigtype_ptr_in(how)
%typemap(how) SWIGTYPE * {
/* %typemap(how) SWIGTYPE * */
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(how) SWIGTYPE (CLASS::*) {
/* %typemap(how) SWIGTYPE (CLASS::*) */
void *v = caml_ptr_val($input,$1_descriptor);
memcpy(& $1, &v, sizeof(v));
}
@ -295,7 +278,6 @@ SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
%define %swigtype_ptr_out(how)
%typemap(out) SWIGTYPE * {
/* %typemap(how) SWIGTYPE *, SWIGTYPE (CLASS::*) */
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = caml_callback(*fromval,caml_val_ptr((void *)$1,$1_descriptor));
@ -304,7 +286,6 @@ SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
}
}
%typemap(how) SWIGTYPE (CLASS::*) {
/* %typemap(how) SWIGTYPE *, SWIGTYPE (CLASS::*) */
void *v;
memcpy(&v,& $1, sizeof(void *));
$result = caml_val_ptr (v,$1_descriptor);

View file

@ -768,10 +768,11 @@ public:
* variableWrapper()
*
* Create a link to a C variable.
* This creates a single function _wrap_swig_var_varname().
* This creates a single function _wrap_varname().
* This function takes a single optional argument. If supplied, it means
* we are setting this variable to some value. If omitted, it means we are
* simply evaluating this variable. In the set case we return C_void.
* simply evaluating this variable. We return the value of the variable
* in both cases.
*
* symname is the name of the variable with respect to C. This
* may need to differ from the original name in the case of enums.
@ -787,9 +788,6 @@ public:
String *proc_name = NewString("");
String *tm;
String *tm2 = NewString("");
String *argnum = NewString("0");
String *arg = NewString("SWIG_Field(args,0)");
Wrapper *f;
if (!name) {
@ -809,14 +807,16 @@ public:
// evaluation function names
String *var_name = Swig_name_wrapper(iname);
// Build the name for scheme.
// Build the name for OCaml.
Printv(proc_name, iname, NIL);
Setattr(n, "wrap:name", proc_name);
Printf(f->def, "SWIGEXT CAML_VALUE %s(CAML_VALUE args) {\n", var_name);
// Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
Wrapper_add_local(f, "swig_result", "CAML_VALUE swig_result");
Wrapper_add_local(f, "args", "CAMLparam1(args)");
Wrapper_add_local(f, "swig_result", "SWIG_CAMLlocal1(swig_result)");
Printf(f->code, "swig_result = Val_unit;\n");
if (!GetFlag(n, "feature:immutable")) {
/* Check for a setting of the variable value */
@ -825,13 +825,12 @@ public:
Replaceall(tm, "$source", "args");
Replaceall(tm, "$target", name);
Replaceall(tm, "$input", "args");
/* Printv(f->code, tm, "\n",NIL); */
emit_action_code(n, f->code, tm);
} else if ((tm = Swig_typemap_lookup("in", n, name, 0))) {
Replaceall(tm, "$source", "args");
Replaceall(tm, "$target", name);
Replaceall(tm, "$input", "args");
Printv(f->code, tm, "\n", NIL);
emit_action_code(n, f->code, tm);
} else {
throw_unhandled_ocaml_type_error(t, "varin/in");
}
@ -849,12 +848,12 @@ public:
Replaceall(tm, "$source", name);
Replaceall(tm, "$target", "swig_result");
Replaceall(tm, "$result", "swig_result");
Printf(f->code, "%s\n", tm);
emit_action_code(n, f->code, tm);
} else {
throw_unhandled_ocaml_type_error(t, "varout/out");
}
Printf(f->code, "\nreturn swig_result;\n");
Printf(f->code, "\nCAMLreturn(swig_result);\n");
Printf(f->code, "}\n");
Wrapper_print(f, f_wrappers);
@ -875,9 +874,6 @@ public:
Delete(var_name);
Delete(proc_name);
Delete(argnum);
Delete(arg);
Delete(tm2);
DelWrapper(f);
return SWIG_OK;
}