[allegrocl] Various fixes to the generated C wrapper code (enums, constants, function declarations), as I progress through the test-suite.

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10885 626c5289-ae23-0410-ae9c-e8d60b6d4f22

CHANGES.current

@@ -1,6 +1,18 @@
+2008-09-26  Mikel Bancroft  <mikel@franz.com>
+
 Version 1.3.37 (in progress)
 ============================
 
+2008-09-26: mutandiz
+	    [allegrocl]
+	    Lots of test-suite work.
+	    - Fix ordering of wrapper output and %{ %} header output.
+	    - Fix declarations of local vars in C wrappers.
+	    - Fix declaration of defined constants in C wrappers.
+	    - Fix declaration of EnumValues in C wrappers.
+	    - add some const typemaps to allegrocl.swg
+	    - add rename for operator bool() overloads.
+	
 2008-09-25: olly
 	    [PHP5] Fill in typemaps for SWIGTYPE and void * (SF#2095186).
 

Examples/test-suite/allegrocl/Makefile.in

@@ -12,98 +12,46 @@ top_builddir = @top_builddir@
 
 # these cpp tests generate warnings/errors when compiling
 # the wrapper .cxx file.
-CPP_TEST_BROKEN_CXX = \
+CPP_TEST_BROKEN_CXX = 
-# might be a problem in our cxx wrapping. not sure. \
+# the error is wrap:action code generated by swig. \
-	class_scope_weird \
+# error: can't convert [std::string] 'b' to 'bool' \
-# works as expected. must muffle warnings if you want none. \
+# might just need a bool overload op for std::string. \
-# 'struct A' is not seen by SWIG, so it's type cannot be \
+	global_vars \
-# derived \
+# same as w/ global_vars but with more errors in cxx file \
-# Look into cxx problems, though.
+	naturalvar \
-	constant_pointers
-
 
 # these cpp tests aren't working. Fix 'em
 # need to further separate these into tests requiring
 # std libraries, or the $ldestructor problem.
 CPP_TEST_BROKEN_ACL = \
-	array_member \
-# seems like a problem with the .i file. not enough includes. \
-	char_strings \
-# not sure what this one is supposed to do. needs investigation. \
-	class_ignore \
 	contract \
+	allprotected \
 # 'throws' typemap entries. \
 	cplusplus_throw \
-# not sure. \
-	cpp_basic \
-# redefinition of enum_members. Looks like a namespace problem. \
-	cpp_enum \
-# works as expected. Bar is not seen by swig. muffle warning. \
-	cpp_typedef \
 # 'throws' typemap entries. \
 	default_args \
-	default_constructor \
+# missing typemaps. suspect module support needed \
 	dynamic_cast \
-	enum_thorough \
 	extend_variable \
-	global_vars \
+# cdata.i support needed \
-	import_nomodule \
-	kind \
-	li_carrays \
 	li_cdata \
-	li_windows \
+# warning generated. otherwise all good. \
-	namespace_class \
-	namespace_spaces \
-	naturalvar \
 	operator_overload \
-	overload_simple \
+# std_common.i support \
-	register_par \
 	sizet \
-	smart_pointer_extend \
+# std_vector.i support. \
-	smart_pointer_namespace \
-	template \
-	template_classes \
 	template_default \
-	template_default_inherit \
+# *** line 31. can't copy typemap?? \
-	template_enum \
-	template_explicit \
-	template_extend_overload \
-	template_ns \
-	template_ns4 \
-	template_ns_enum \
-	template_rename \
-	template_retvalue \
-	template_static \
-	template_tbase_template \
-	template_typedef \
-	template_typedef_cplx \
-	template_typedef_cplx2 \
-	template_typedef_cplx3 \
-	template_typedef_cplx4 \
-	template_typedef_cplx5 \
-	template_typedef_ns \
-	template_typedef_rec \
-	threads \
-	typedef_array_member \
-	typedef_sizet \
 	typemap_namespace \
-	union_scope \
-	using_pointers \
-	valuewrapper_opaque \
-	varargs \
-	virtual_poly \
-	voidtest \
-	wrapmacro
 
 # these aren't working due to longlong support. (low hanging fruit)
 CPP_TEST_BROKEN_LONGLONG = \
 	arrays_dimensionless \
 	arrays_global \
 	arrays_global_twodim \
-	li_stdint \
 	li_typemaps \
+	li_windows \
 	long_long_apply \
-	mixed_types \
 	primitive_ref \
 	reference_global_vars \
 	template_default_arg
@@ -112,38 +60,24 @@ CPP_TEST_BROKEN_LONGLONG = \
 CPP_TEST_CASES_ACL_UNSUPPORTED = \
 # contract support \
 	aggregate \
-# directors and allprotected support \
-	allprotected \
 # directors support \
 	apply_signed_char \
 # contract support \
 	contract \
-	director_abstract \
-	director_basic \
-	director_constructor \
-	director_detect \
-	director_default \
-	director_enum \
 	director_exception \
-	director_frob \
-	director_finalizer \
-	director_nested \
 	director_protected \
-	director_redefined \
-	director_unroll \
-	director_using \
-	director_wombat \
 	exception_order \
+# 'throws' typemap support \
 	extern_throws \
-	throw_exception
+	throw_exception \
+	using_pointers \
 		
 C_TEST_CASES_ACL_BROKEN = \
-	arrays \
+# 'cdate.i' module support \
-	enums \
-	extern_declaration \
-	immutable \
-	integers \
 	li_cdata \
+# adding an existing type defnition... \
+	typedef_struct \
+# swigrun.swg support. \
 	typemap_subst
 
 C_TEST_BROKEN_LONGLONG = \
@@ -153,12 +87,10 @@ C_TEST_BROKEN_LONGLONG = \
 # std lib support hasn't been done yet.
 SKIP_CPP_STD_CASES = Yes
 
-C_TEST_CASES =
-
-CPP_TEST_CASES = 
-
 include $(srcdir)/../common.mk
 
+# SWIGOPT += -debug-module 4
+
 # Rules for the different types of tests
 %.cpptest: 
 	$(setup)

Examples/test-suite/operator_overload.i

@@ -71,6 +71,12 @@ see bottom for a set of possible tests
 %rename(OrOperator) operator ||;
 #endif
 
+#ifdef SWIG_ALLEGRO_CL
+%{
+#include <stdio.h>
+%}
+#endif
+
 %rename(IntCast) operator int();
 %rename(DoubleCast) operator double();
 

Lib/allegrocl/allegrocl.swg

@@ -26,37 +26,76 @@
 
 %typemap(lout) SWIGTYPE         "(cl::let* ((address $body)\n         (new-inst (cl::make-instance '$lclass :foreign-address address)))\n    (cl::unless (cl::zerop address)\n      (excl:schedule-finalization new-inst #'$ldestructor))\n    (cl::setq ACL_ffresult new-inst))";
 
-%typemap(lisptype) bool "cl:boolean";
+%typemap(lisptype) bool, const bool "cl:boolean";
-%typemap(lisptype) char "cl:character";
+%typemap(lisptype) char, const char "cl:character";
-%typemap(lisptype) unsigned char "cl:integer";
+%typemap(lisptype) unsigned char, const unsigned char "cl:integer";
-%typemap(lisptype) signed char "cl:integer";
+%typemap(lisptype) signed char, const signed char "cl:integer";
 
-%typemap(ffitype) bool ":int";
+%typemap(ffitype) bool, const bool ":int";
-%typemap(ffitype) char ":char";
+%typemap(ffitype) char, const char,
-%typemap(ffitype) unsigned char ":unsigned-char";
+		  signed char, const signed char ":char";
-%typemap(ffitype) signed char ":char";
+%typemap(ffitype) unsigned char, const unsigned char ":unsigned-char";
-%typemap(ffitype) short, signed short ":short";
+%typemap(ffitype) short, const short,
-%typemap(ffitype) unsigned short ":unsigned-short";
+		  signed short, const signed short ":short";
-%typemap(ffitype) int, signed int ":int";
+%typemap(ffitype) unsigned short, const unsigned short ":unsigned-short";
-%typemap(ffitype) unsigned int ":unsigned-int";
+%typemap(ffitype) int, const int, signed int, const signed int ":int";
-%typemap(ffitype) long, signed long ":long";
+%typemap(ffitype) unsigned int, const unsigned int ":unsigned-int";
-%typemap(ffitype) unsigned long ":unsigned-long";
+%typemap(ffitype) long, const long, signed long, const signed long ":long";
-%typemap(ffitype) float ":float";
+%typemap(ffitype) unsigned long, const unsigned long ":unsigned-long";
-%typemap(ffitype) double ":double";
+%typemap(ffitype) float, const float ":float";
-%typemap(ffitype) char * "(* :char)";
+%typemap(ffitype) double, const double ":double";
+%typemap(ffitype) char *, const char *, signed char *,
+		  const signed char *, signed char &,
+		  const signed char &			 "(* :char)";
+%typemap(ffitype) unsigned char *, const unsigned char *,
+		  unsigned char &, const unsigned char & "(* :unsigned-char)";
+%typemap(ffitype) short *, const short *, short &,
+		  const short &				"(* :short)";
+%typemap(ffitype) unsigned short *, const unsigned short *,
+		  unsigned short &, const unsigned short & "(* :unsigned-short)";
+%typemap(ffitype) int *, const int *, int &, const int & "(* :int)";
+%typemap(ffitype) unsigned int *, const unsigned int *,
+		  unsigned int &, const unsigned int &	"(* :unsigned-int)";
 %typemap(ffitype) void * "(* :void)";
 %typemap(ffitype) void ":void";
 %typemap(ffitype) enum SWIGTYPE ":int";
 %typemap(ffitype) SWIGTYPE & "(* :void)";
 
-%typemap(ctype) bool                       "int";
+/* const typemaps
+idea: marshall all primitive c types to their respective lisp types
+to maintain const corretness. For pointers/references, all bets
+are off if you try to modify them.
+
+idea: add a constant-p slot to the base foreign-pointer class. For
+constant pointer/references check this value when setting (around method?)
+and error if a setf operation is performed on the address of this object.
+
+*/
+
+/* 
+%exception %{
+   try {
+      $action
+   } catch (...) {
+      return $null;
+   }
+%}
+
+*/
+
+// %typemap(throws) SWIGTYPE {
+//   (void)$1;
+//   SWIG_fail;
+// }
+
+%typemap(ctype) bool, const bool		"int";
 %typemap(ctype) char, unsigned char, signed char,
                 short, signed short, unsigned short,
                 int, signed int, unsigned int,
                 long, signed long, unsigned long,
                 float, double, long double, char *, void *, void,
                 enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[],
-                SWIGTYPE[ANY], SWIGTYPE &  "$1_ltype";
+                SWIGTYPE[ANY], SWIGTYPE &, const SWIGTYPE  "$1_ltype";
 %typemap(ctype) SWIGTYPE                   "$&1_type";
 
 %typemap(in) bool                          "$1 = (bool)$input;";
@@ -122,7 +161,8 @@ SWIG_TYPECHECK_STRING_ARRAY      1140
                     long, signed long, unsigned long,
                     enum SWIGTYPE { $1 = 1; };
 %typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &,
-                                   SWIGTYPE[ANY], SWIGTYPE { $1 = 1; };
+				   SWIGTYPE[], SWIGTYPE[ANY],
+				   SWIGTYPE { $1 = 1; };
 
 /* This maps C/C++ types to Lisp classes for overload dispatch */
 
@@ -147,7 +187,7 @@ SWIG_TYPECHECK_STRING_ARRAY      1140
               enum SWIGTYPE, SWIGTYPE *,
               SWIGTYPE[ANY], SWIGTYPE &    "$result = $1;";
 #ifdef __cplusplus
-%typemap(out) SWIGTYPE                     "$result = new $1_type($1);";
+%typemap(out) SWIGTYPE                     "$result = new $1_ltype($1);";
 #else
 %typemap(out) SWIGTYPE {
   $result = ($&1_ltype) malloc(sizeof($1_type));
@@ -243,6 +283,9 @@ $body)"
 
 %rename(__funcall__)	     *::operator();
 %rename(__aref__)	     *::operator[];
+
+%rename(__bool__)	     *::operator bool();
+%rename(__bool__)	     *::operator bool() const;
 #endif
 
 %insert("lisphead") %{

Source/Modules/allegrocl.cxx

@@ -170,7 +170,7 @@ static String *namespace_of(String *str) {
 void add_linked_type(Node *n) {
 #ifdef ALLEGROCL_CLASS_DEBUG
   Printf(stderr, "Adding linked node of type: %s(%s) %s(%x)\n\n", nodeType(n), Getattr(n, "storage"), Getattr(n, "name"), n);
-  Swig_print_node(n);
+  // Swig_print_node(n);
 #endif
   if (!first_linked_type) {
     first_linked_type = n;
@@ -757,7 +757,7 @@ String *internal_compose_foreign_type(SwigType *ty) {
 	  Setattr(nn,"kind","class");
 	  Setattr(nn,"sym:name",tok_name);
 	  Setattr(nn,"name",tok_key);
-	  Setattr(nn,"allegrocl:package","current_namespace");
+	  Setattr(nn,"allegrocl:package",current_namespace);
 
 	  add_forward_referenced_type(nn, 0);
 	  Printf(ffiType, "%s", get_ffi_type(tok, ""), tok_name);
@@ -773,7 +773,8 @@ String *compose_foreign_type(SwigType *ty, String * /*id*/ = 0) {
 /*  Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0); */
 
 #ifdef ALLEGROCL_TYPE_DEBUG
-  Printf(stderr, "compose_foreign_type: ENTER (%s)(%s)...\n ", ty, (id ? id : 0));
+  Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty);
+  // Printf(stderr, "compose_foreign_type: ENTER (%s)(%s)...\n ", ty, (id ? id : 0));
   /* String *id_ref = SwigType_str(ty, id);
   Printf(stderr, "looking up typemap for %s, found '%s'(%x)\n",
 	 id_ref, lookup_res ? Getattr(lookup_res, "code") : 0, lookup_res);
@@ -1336,7 +1337,6 @@ void emit_typedef(Node *n) {
 
   // leave these in for now. might want to change these to def-foreign-class at some point.
 //  Printf(f_clhead, ";; %s\n", SwigType_typedef_resolve_all(lisp_type));
-  // Swig_print_node(n);
   Printf(f_clhead, "(swig-def-foreign-type \"%s\"\n  %s)\n", name, lisp_type);
 
   Delete(name);
@@ -1659,6 +1659,8 @@ int ALLEGROCL::top(Node *n) {
   Delete(f_clhead);
   Delete(f_clwrap);
 
+  Printf(f_cxx, "%s\n", f_cxx_wrapper);
+
   Close(f_cxx);
   Delete(f_cxx);
   Delete(f_cxx_wrapper);
@@ -2554,6 +2556,7 @@ int ALLEGROCL::emit_defun(Node *n, File *fcl) {
 int ALLEGROCL::functionWrapper(Node *n) {
 #ifdef ALLEGROCL_DEBUG
 	Printf(stderr, "functionWrapper %s\n", Getattr(n,"name"));
+	Swig_print_node(n);
 #endif
 
 
@@ -2570,11 +2573,13 @@ int ALLEGROCL::functionWrapper(Node *n) {
   Delete(resolved);
 
   if (!is_void_return) {
-    String *lresult_init = NewStringf("= (%s)0", raw_return_type);
+     String *lresult_init =
-    Wrapper_add_localv(f, "lresult",
+	     NewStringf("= (%s)0",
-		       SwigType_lstr(SwigType_ltype(return_type), "lresult"),
+			SwigType_str(SwigType_strip_qualifiers(return_type),0));
-		       lresult_init, NIL);
+     Wrapper_add_localv(f, "lresult",
-    Delete(lresult_init);
+			SwigType_lstr(SwigType_ltype(return_type), "lresult"),
+			lresult_init, NIL);
+     Delete(lresult_init);
   }
   // Emit all of the local variables for holding arguments.
   emit_parameter_variables(parms, f);
@@ -2687,14 +2692,15 @@ int ALLEGROCL::functionWrapper(Node *n) {
   if (CPlusPlus) {
     Printf(f->code, "  } catch (...) {\n");
     if (!is_void_return)
-      Printf(f->code, "    return (%s)0;\n", raw_return_type);
+      Printf(f->code, "    return (%s)0;\n",
+	     SwigType_str(SwigType_strip_qualifiers(return_type),0));
     Printf(f->code, "  }\n");
   }
   Printf(f->code, "}\n");
 
   /* print this when in C mode? make this a command-line arg? */
   if (Generate_Wrapper)
-    Wrapper_print(f, f_cxx);
+    Wrapper_print(f, f_cxx_wrapper);
 
   String *f_buffer = NewString("");
 
@@ -2796,8 +2802,9 @@ int ALLEGROCL::constantWrapper(Node *n) {
     SwigType_add_qualifier(const_type, "const");
     SwigType_add_qualifier(const_type, "static");
 
-    String *ppcname = NewStringf("ACLppc_%s", Getattr(n, "name"));
+    String *ppcname = NewStringf("ACLppc_%s", Getattr(n, "sym:name"));
-    Printf(f_cxx, "static const %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
+    // Printf(f_cxx, "static const %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
+    Printf(f_cxx, "%s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
 
     Setattr(n, "name", ppcname);
     SetFlag(n, "feature:immutable");
@@ -2936,7 +2943,6 @@ int ALLEGROCL::membervariableHandler(Node *n) {
 int ALLEGROCL::typedefHandler(Node *n) {
 #ifdef ALLEGROCL_TYPE_DEBUG
   Printf(stderr, "In typedefHandler\n");
-  // Swig_print_node(n);
 #endif
 
   SwigType *typedef_type = Getattr(n,"type");
@@ -2969,12 +2975,15 @@ int ALLEGROCL::typedefHandler(Node *n) {
   String *lookup = lookup_defined_foreign_type(typedef_type);
 
 #ifdef ALLEGROCL_TYPE_DEBUG
-  Printf(stderr, "** lookup='%s'(%x), ff_type='%s', !strstr = '%d'\n", lookup, lookup, ff_type, !Strstr(ff_type,"void"));
+  Printf(stderr, "** lookup='%s'(%x), typedef_type='%s', strcmp = '%d' strstr = '%d'\n", lookup, lookup, typedef_type, Strcmp(typedef_type,"void"), Strstr(ff_type,"__SWIGACL_FwdReference"));
 #endif
 
-  if(lookup || (!lookup && !Strstr(ff_type,"__SWIGACL_FwdReference")))
+  if(lookup || (!lookup && Strcmp(typedef_type,"void")) ||
+     (!lookup && Strstr(ff_type,"__SWIGACL_FwdReference"))) {
 	  add_defined_foreign_type(n, 0, type_ref, name);
-  else add_forward_referenced_type(n);
+  } else {
+     add_forward_referenced_type(n);
+  }
 
 #ifdef ALLEGROCL_TYPE_DEBUG
   Printf(stderr, "Out typedefHandler\n");
@@ -3000,10 +3009,14 @@ int ALLEGROCL::classHandler(Node *n) {
   Printf(stderr, "classHandler %s::%s\n", current_namespace, Getattr(n, "sym:name"));
 #endif
 
+  int result;
+
   if (Generate_Wrapper)
-    return cppClassHandler(n);
+    result = cppClassHandler(n);
   else
-    return cClassHandler(n);
+    result = cClassHandler(n);
+
+  return result;
 }
 
 int ALLEGROCL::cClassHandler(Node *n) {
@@ -3094,7 +3107,6 @@ int ALLEGROCL::cppClassHandler(Node *n) {
 				     Getattr(c, "type"));
 #ifdef ALLEGROCL_CLASS_DEBUG
     Printf(stderr, "looking at child '%x' of type '%s'\n", c, childType);
-    Swig_print_node(c);
 #endif
     if (!SwigType_isfunction(childType))
       Delete(compose_foreign_type(childType));
@@ -3160,11 +3172,21 @@ int ALLEGROCL::enumvalueDeclaration(Node *n) {
 #endif
   /* print this when in C mode? make this a command-line arg? */
   if (Generate_Wrapper) {
-    String *mangled_name = mangle_name(n, "ACL_ENUM");
+	  SwigType *enum_type = Copy(Getattr(n,"type"));
-    Printf(f_cxx, "EXPORT const %s %s = %s;\n", Getattr(n, "type"),
+	  String *mangled_name =
-	   mangled_name, Getattr(n, "value"));
+		  mangle_name(n, "ACL_ENUM",
+			      in_class ? Getattr(in_class,"name") :
+			      current_namespace);
+	  
+	  SwigType_add_qualifier(enum_type,"const");
+
+	  String *enum_decl = SwigType_str(enum_type, mangled_name);
+	  Printf(f_cxx_wrapper, "EXPORT %s;\n", enum_decl);
+	  Printf(f_cxx_wrapper, "%s = %s;\n", enum_decl, Getattr(n, "value"));
 
     Delete(mangled_name);
+    Delete(enum_type);
+    Delete(enum_decl);
   }
   return SWIG_OK;
 }

TODO

@@ -339,6 +339,14 @@ Common Lisp
        typemaps would be written as Lisp programs that generate Lisp
        code.
 
+ALLEGROCL
+-----
+These first three will remove most of the warnings from most of the
+remaining checkpartial tests that are failing.
+****  Throws typemap support
+****  const typemaps
+****  long long typemaps
+
 Ocaml
 -----
 **     I've been working with my camlp4 module and type information