[ 841074 ] better croaking (PATCH)

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

Lib/perl5/perl5.swg

@@ -499,20 +499,23 @@
                   unsigned int, 
                   unsigned long, 
                   unsigned short {
-  sprintf(_swigmsg,"%d",$1);
+  SWIG_SetErrorf("%d", $1); SWIG_fail;
-  SWIG_croak(_swigmsg);
 }
 
-%typemap(throws) SWIGTYPE {
+/* throws real objects */
-  SWIG_croak("$1_type");
+%typemap(throws) SWIGTYPE 
+{
+  SV *esv=sv_newmortal();
+  $&1_ltype copy = new $1_ltype(($1_ltype &)$1);
+  SWIG_MakePtr(esv, (void *) copy,
+	       $&1_descriptor, SWIG_OWNER);
+  SWIG_croakSV(esv);
 }
 
 %typemap(throws) char * {
   SWIG_croak($1);
-  SWIG_fail;
 }
 
-
 /* Export the SWIG initialization function */
 %header %{
 #ifdef __cplusplus

Lib/perl5/perlrun.swg

@@ -43,11 +43,6 @@ extern "C" {
 #endif 
 #endif 
 
-/* Macros for low-level exception handling */
-#define SWIG_fail      goto fail
-#define SWIG_croak(x)  { if ((_swigerr = (const char *) x)) goto fail; }
-#define SWIG_MAX_ERRMSG 256
-
 /* Contract support */
 
 #define SWIG_contract_assert(expr,msg) if (!(expr)) { SWIG_croak(msg); } else
@@ -146,12 +141,21 @@ extern "C" {
      SWIG_Perl_MakePtr(pPerl, sv, ptr, type, flags)
 #  define SWIG_TypeCheckRV(rv, ty) \
      SWIG_Perl_TypeCheckRV(pPerl, rv, ty)
+#  define SWIG_SetError(str) \
+     SWIG_Perl_SetError(pPerl, str)
 #else
 #  define SWIG_MakePtr(sv, ptr, type, flags) \
      SWIG_Perl_MakePtr(sv, ptr, type, flags)
 #  define SWIG_TypeCheckRV(rv, ty) \
      SWIG_Perl_TypeCheckRV(rv, ty)
+#  define SWIG_SetError(str) \
+     SWIG_Perl_SetError(str)
+#  define SWIG_SetErrorSV(str) \
+     SWIG_Perl_SetErrorSV(str)
 #endif
+
+#define SWIG_SetErrorf SWIG_Perl_SetErrorf
+
   
 #ifdef PERL_OBJECT
 #  define SWIG_MAYBE_PERL_OBJECT CPerlObj *pPerl,
@@ -173,6 +177,10 @@ SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT
 extern swig_type_info *
 SWIG_Perl_TypeCheckRV(SWIG_MAYBE_PERL_OBJECT
 		      SV *rv, swig_type_info *ty);
+
+extern SV *
+SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT
+		   char *);
        
 #else
  
@@ -308,8 +316,40 @@ SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT
   return result;
 }
 
+SWIGRUNTIME(void)
+SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT
+		   const char *error)
+{
+    if (error) sv_setpv(get_sv("@", TRUE), error);
+}
+
+SWIGRUNTIME(void)
+SWIG_Perl_SetErrorSV(SWIG_MAYBE_PERL_OBJECT
+		     SV *error)
+{
+    if (error) sv_setsv(get_sv("@", TRUE), error);
+}
+
+SWIGRUNTIME(void)
+SWIG_Perl_SetErrorf(const char *fmt, ...)
+{
+    va_list args;
+    va_start(args, fmt);
+    sv_vsetpvfn(get_sv("@", TRUE), fmt, strlen(fmt), &args,
+		Null(SV**), 0, Null(bool*));
+    va_end(args);
+}
+
 #endif
 
+/* Macros for low-level exception handling */
+#define SWIG_fail       goto fail
+#define SWIG_croak(x)   { SWIG_SetError(x); goto fail; }
+#define SWIG_croakSV(x) { SWIG_SetErrorSV(x); goto fail; }
+/* most preprocessors do not support vararg macros :-( */
+/* #define SWIG_croakf(x...) { SWIG_SetErrorf(x); goto fail; } */
+                          
+
 typedef XS(SwigPerlWrapper);
 typedef SwigPerlWrapper *SwigPerlWrapperPtr;
 

Source/Modules/perl5.cxx

@@ -516,9 +516,10 @@ public:
       Append(wname,overname);
     }
     Setattr(n,"wrap:name",wname);
-    Printv(f->def, "XS(", wname, ") {\n", NIL);
+    Printv(f->def,
-    Printv(f->def, "char _swigmsg[SWIG_MAX_ERRMSG] = \"\";\n", NIL);
+	   "XS(", wname, ") {\n",
-    Printv(f->def, "const char *_swigerr = _swigmsg;\n","{\n",NIL);
+	   "{\n", /* scope to destroy C++ objects before croaking */
+	   NIL );
 
     emit_args(d, l, f);
     emit_attach_parmmaps(l,f);
@@ -685,14 +686,16 @@ public:
       Printf(f->code,"%s\n", tm);
     }
 
-    Printf(f->code,"    XSRETURN(argvi);\n");
+    Printv(f->code,
-    Printf(f->code,"fail:\n");
+	   "XSRETURN(argvi);\n",
-    Printv(f->code,cleanup,NIL);
+	   "fail:\n",
-    Printv(f->code,"(void) _swigerr;\n", NIL);
+	   cleanup,
-    Printv(f->code,"}\n",NIL);
+	   ";\n", /* empty statement */
-    Printv(f->code,"croak(_swigerr);\n", NIL);
+	   "}\n",
-    Printv(f->code,"}\n",NIL);
+	   "croak(Nullch);\n"
-
+	   "}\n",
+	   NIL);
+	   
   /* Add the dXSARGS last */
 
     Wrapper_add_local(f,"dXSARGS","dXSARGS");