[allegrocl] Fix handling of forward references. Remove code breaking typical code generation. See ChangeLog for more details on the latter.

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

CHANGES.current

@@ -1,6 +1,22 @@
 Version 1.3.37 (in progress)
 =============================
 
+2008-09-17: mutandiz (Mikel Bancroft)
+	    [allegrocl]
+	    - Fix how forward reference typedefs are handled, so as not to conflict
+	    with other legit typedefs.
+	    - Don't (for now) perform an ffitype typemap lookup when trying to
+	    when calling compose_foreign_type(). This is actually a useful thing
+	    to do in certain cases, the test cases for which I can't currently
+	    locate :/. It's breaking some wrapping behavior that is more commonly
+	    seen, however. I'll readd in a more appropriate way when I can
+	    recreate the needed test case, or a user complains (which means
+	    they probably have a test case).
+	    - document the -isolate command-line arg in the 'swig -help' output.
+	    It was in the html docs, but not there.
+	    - small amount of code cleanup, removed some unused code.
+	    - some minor aesthetic changes.
+
 2008-09-12: bhy
             [Python] Python 3.0 support branch merged into SWIG trunk. Thanks
             Google Summer of Code 2008 for support this project! By default

Lib/allegrocl/allegrocl.swg

@@ -248,7 +248,7 @@ $body)"
 %insert("lisphead") %{
 ;; $Id$
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
   ;; avoid compiling ef-templates at runtime
   (excl:find-external-format :fat)
@@ -375,7 +375,7 @@ $body)"
 
 (defswig2 swig-defconstant (string value)
   (cl::let ((symbol (id-convert-and-export string :type :constant)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
        (cl::defconstant ,symbol ,value))))
 
 (cl::defun maybe-reorder-args (funcname arglist)
@@ -421,7 +421,7 @@ $body)"
 	 )
     (cl::when (swig-anyvarargs-p ffargs)
       (cl::setq ffargs '()))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
        (excl::compiler-let ((*record-xref-info* nil))
          (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
        (cl::macrolet ((swig-ff-call (&rest args)
@@ -447,7 +447,7 @@ $body)"
                      ffargs
                      (cl::loop for (nil name nil . ffi) in ffargs
                            collect `(,name ,@ffi)))))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
        (excl::compiler-let ((*record-xref-info* nil))
          (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
        (cl::macrolet ((swig-ff-call (&rest args)
@@ -459,7 +459,7 @@ $body)"
 (defswig1 swig-dispatcher ((name &key (type :operator) class arities))
   (cl::let ((symbol (id-convert-and-export name
                          :type type :class class)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
        (cl::defun ,symbol (&rest args)
          (cl::case (cl::length args)
            ,@(cl::loop for arity in arities
@@ -472,14 +472,14 @@ $body)"
 (defswig2 swig-def-foreign-stub (name)
   (cl::let ((lsymbol (id-convert-and-export name :type :class))
 	    (symbol (id-convert-and-export name :type :type)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
 	(ff:def-foreign-type ,symbol (:class ))
 	(cl::defclass ,lsymbol (ff:foreign-pointer) ()))))
 
 (defswig2 swig-def-foreign-class (name supers &rest rest)
   (cl::let ((lsymbol (id-convert-and-export name :type :class))
 	    (symbol (id-convert-and-export name :type :type)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
        (ff:def-foreign-type ,symbol ,@rest)
        (cl::defclass ,lsymbol ,supers
 	 ((foreign-type :initform ',symbol :initarg :foreign-type
@@ -487,11 +487,11 @@ $body)"
 
 (defswig2 swig-def-foreign-type (name &rest rest)
   (cl::let ((symbol (id-convert-and-export name :type :type)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
        (ff:def-foreign-type ,symbol ,@rest))))
 
 (defswig2 swig-def-synonym-type (synonym of ff-synonym)
-  `(cl::eval-when (compile load eval)
+  `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
      (cl::setf (cl::find-class ',synonym) (cl::find-class ',of))
      (ff:def-foreign-type ,ff-synonym (:struct ))))
 
@@ -511,24 +511,24 @@ $body)"
              (parent-strings (cl::mapcar #'package-name-for-namespace
                                  parent-namespaces))
              (string (package-name-for-namespace namespace)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
       (cl::defpackage ,string
         (:use :swig :ff #+ignore '(:common-lisp :ff :excl)
               ,@parent-strings ,*swig-module-name*)
 	(:import-from :cl :* :nil :t)))))
 
 (cl::defmacro swig-in-package (namespace)
-  `(cl::eval-when (compile load eval)
+  `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
     (cl::in-package ,(package-name-for-namespace namespace))))
 
 (defswig2 swig-defvar (name mangled-name &key type (ftype :unsigned-natural))
   (cl::let ((symbol (id-convert-and-export name :type type)))
-    `(cl::eval-when (compile load eval)
+    `(cl::eval-when (:compile-toplevel :load-toplevel :execute)
       (ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype))))
 
 ) ;; eval-when
 
-(cl::eval-when (compile eval)
+(cl::eval-when (:compile-toplevel :execute)
   (cl::flet ((starts-with-p (str prefix)
               (cl::and (cl::>= (cl::length str) (cl::length prefix))
                 (cl::string= str prefix :end1 (cl::length prefix)))))
@@ -539,7 +539,7 @@ $body)"
 
 %}
 
-
+typedef void *__SWIGACL_FwdReference;
 
 %{
 
@@ -551,6 +551,8 @@ $body)"
 
 #define EXPORT   EXTERN SWIGEXPORT
 
+typedef void *__SWIGACL_FwdReference;
+
 #include <string.h>
 #include <stdlib.h>
 %}

Source/Modules/allegrocl.cxx

@@ -34,6 +34,8 @@ static bool CWrap = true;	// generate wrapper file for C code by default. most c
 static bool Generate_Wrapper = false;
 static bool unique_swig_package = false;
 
+static SwigType *fwdref_ffi_type = NewString("__SWIGACL_FwdReference");
+
 static String *current_namespace = NewString("");
 static String *current_package = NewString("");
 static Hash *defined_namespace_packages = NewHash();
@@ -725,7 +727,7 @@ String *internal_compose_foreign_type(SwigType *ty) {
 	  } else {
 	    Printf(stderr, "Unable to compose foreign type of: '%s'\n", tok);
 	  }
-	  Printf(ffiType, "(* :void)");
+	  Printf(ffiType, "%s", get_ffi_type(fwdref_ffi_type, ""));
 	}
       }
     }
@@ -735,22 +737,33 @@ String *internal_compose_foreign_type(SwigType *ty) {
 
 String *compose_foreign_type(SwigType *ty, String *id = 0) {
 
-  Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0);
+/*  Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0); */
+
 #ifdef ALLEGROCL_TYPE_DEBUG
-  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);
+  /* 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);
+  if (lookup_res) Swig_print_node(lookup_res);
+  */
 #endif
+
   /* should we allow named lookups in the typemap here? YES! */
   /* unnamed lookups should be found in get_ffi_type, called
      by internal_compose_foreign_type(), below. */
+
+  /* I'm reverting to 'no' for the question above. I can no longer
+     remember why I needed it. If a user needed it, I'll find out
+     as soon as they upgrade. Sigh. -mutandiz 9/16/2008. */
+
+/*
   if(id && lookup_res) {
 #ifdef ALLEGROCL_TYPE_DEBUG
     Printf(stderr, "compose_foreign_type: EXIT-1 (%s)\n ", Getattr(lookup_res, "code"));
 #endif
     return NewString(Getattr(lookup_res, "code"));
   }
+*/
 
   SwigType *temp = SwigType_strip_qualifiers(ty);
   String *res = internal_compose_foreign_type(temp);
@@ -1516,7 +1529,10 @@ void ALLEGROCL::main(int argc, char *argv[]) {
 	      "\tcalled to convert identifiers to symbols.\n"
 	      "\n"
 	      "   -[no]cwrap\n"
-	      "\tTurn on or turn off generation of an intermediate C file when\n" "\tcreating a C interface. By default this is only done for C++ code.\n");
+	      "\tTurn on or turn off generation of an intermediate C file when\n" "\tcreating a C interface. By default this is only done for C++ code.\n"
+	      "   -isolate\n"
+	      "Define all SWIG helper functions in a package unique to this module. Avoids redefinition warnings when loading multiple SWIGged modules\n"
+	      "into the same running Allegro CL image.\n");
 
     }
 
@@ -1571,7 +1587,7 @@ int ALLEGROCL::top(Node *n) {
 	 "  (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
 	 "           #:*void* #:*swig-export-list*))\n"
 	 "(in-package :%s)\n\n"
-	 "(eval-when (compile load eval)\n"
+	 "(eval-when (:compile-toplevel :load-toplevel :execute)\n"
 	 "  (defparameter *swig-identifier-converter* '%s)\n"
 	 "  (defparameter *swig-module-name* :%s))\n\n", swig_package, swig_package, identifier_converter, module_name);
   Printf(f_cl, "(defpackage :%s\n" "  (:use :common-lisp :%s :ff :excl))\n\n", module_name, swig_package);
@@ -2632,13 +2648,18 @@ int ALLEGROCL::functionWrapper(Node *n) {
 
   String *tm = Swig_typemap_lookup_out("out", n, "result", f, actioncode);
   if (!is_void_return && tm) {
-    Replaceall(tm, "$result", "lresult");
+    if (tm) { 
-    Printf(f->code, "%s\n", tm);
+      Replaceall(tm, "$result", "lresult");
-    Printf(f->code, "    return lresult;\n");
+      Printf(f->code, "%s\n", tm);
-    Delete(tm);
+      Printf(f->code, "    return lresult;\n");
-  } else {
+      Delete(tm);
-    Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(t, 0), name);
+    } else {
+      Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
+		   "Unable to use return type %s in function %s.\n",
+		   SwigType_str(t, 0), name);
+    }
   }
+
   emit_return_variable(n, t, f);
 
   if (CPlusPlus) {
@@ -2901,9 +2922,7 @@ int ALLEGROCL::typedefHandler(Node *n) {
     Printf(stderr, "  typedef in class '%s'(%x)\n", Getattr(in_class, "sym:name"), in_class);
 #endif
     Setattr(n, "allegrocl:typedef:in-class", in_class);
-  }
 
-  if (in_class) {
     String *class_name = Getattr(in_class, "name");
     name = NewStringf("%s__%s", class_name, sym_name);
     type_ref = NewStringf("%s::%s", class_name, sym_name);
@@ -2917,9 +2936,11 @@ int ALLEGROCL::typedefHandler(Node *n) {
 
   String *lookup = lookup_defined_foreign_type(typedef_type);
 
-  // Printf(stderr, "** lookup='%s'(%x), ff_type='%s', strstr = '%d'\n", lookup, lookup, ff_type, !Strstr(ff_type,"void"));
+#ifdef ALLEGROCL_TYPE_DEBUG
+  Printf(stderr, "** lookup='%s'(%x), ff_type='%s', !strstr = '%d'\n", lookup, lookup, ff_type, !Strstr(ff_type,"void"));
+#endif
 
-  if(lookup || (!lookup && !Strstr(ff_type,"void")))
+  if(lookup || (!lookup && !Strstr(ff_type,"__SWIGACL_FwdReference")))
 	  add_defined_foreign_type(n, 0, type_ref, name);
   else add_forward_referenced_type(n);