From e7a4f42877037e7c8c443584ce6d6e43bf46110d Mon Sep 17 00:00:00 2001
From: Robert Stone <talby@trap.mtview.ca.us>
Date: Sat, 10 Dec 2011 18:33:04 +0000
Subject: [PATCH] perl5 error handling improvements

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@12873 626c5289-ae23-0410-ae9c-e8d60b6d4f22
---
 CHANGES.current            |  4 ++++
 Lib/perl5/perlerrors.swg   | 39 ++++++++++++--------------------------
 Lib/perl5/perlrun.swg      | 15 ++++++---------
 Lib/perl5/perltypemaps.swg |  2 +-
 4 files changed, 23 insertions(+), 37 deletions(-)

diff --git a/CHANGES.current b/CHANGES.current
index fc17331c8..2165d84f1 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -5,6 +5,10 @@ See the RELEASENOTES file for a summary of changes in each release.
 Version 2.0.5 (in progress)
 ===========================
 
+2011-12-10: talby
+            [perl5] SWIG_error() now gets decorated with perl source file/line number.
+            [perl5] error handling now conforms to public XS api (fixes perl v5.14 issue).
+
 2011-12-10: wsfulton
             [Android/Java] Fix directors to compile on Android.
 
diff --git a/Lib/perl5/perlerrors.swg b/Lib/perl5/perlerrors.swg
index 024f03798..57296c679 100644
--- a/Lib/perl5/perlerrors.swg
+++ b/Lib/perl5/perlerrors.swg
@@ -4,46 +4,31 @@
 
 SWIGINTERN const char*
 SWIG_Perl_ErrorType(int code) {
-  const char* type = 0;
   switch(code) {
   case SWIG_MemoryError:
-    type = "MemoryError";
-    break;
+    return "MemoryError";
   case SWIG_IOError:
-    type = "IOError";
-    break;
+    return "IOError";
   case SWIG_RuntimeError:
-    type = "RuntimeError";
-    break;
+    return "RuntimeError";
   case SWIG_IndexError:
-    type = "IndexError";
-    break;
+    return "IndexError";
   case SWIG_TypeError:
-    type = "TypeError";
-    break;
+    return "TypeError";
   case SWIG_DivisionByZero:
-    type = "ZeroDivisionError";
-    break;
+    return "ZeroDivisionError";
   case SWIG_OverflowError:
-    type = "OverflowError";
-    break;
+    return "OverflowError";
   case SWIG_SyntaxError:
-    type = "SyntaxError";
-    break;
+    return "SyntaxError";
   case SWIG_ValueError:
-    type = "ValueError";
-    break;
+    return "ValueError";
   case SWIG_SystemError:
-    type = "SystemError";
-    break;
+    return "SystemError";
   case SWIG_AttributeError:
-    type = "AttributeError";
-    break;
+    return "AttributeError";
   default:
-    type = "RuntimeError";
+    return "RuntimeError";
   }
-  return type;
 }
 
-
-
diff --git a/Lib/perl5/perlrun.swg b/Lib/perl5/perlrun.swg
index 4130a065e..5c1b586b4 100644
--- a/Lib/perl5/perlrun.swg
+++ b/Lib/perl5/perlrun.swg
@@ -47,7 +47,7 @@
 /* Error manipulation */
 
 #define SWIG_ErrorType(code)                            SWIG_Perl_ErrorType(code)               
-#define SWIG_Error(code, msg)            		sv_setpvf(GvSV(PL_errgv),"%s %s\n", SWIG_ErrorType(code), msg)
+#define SWIG_Error(code, msg)            		sv_setpvf(get_sv("@", GV_ADD), "%s %s", SWIG_ErrorType(code), msg)
 #define SWIG_fail                        		goto fail						    
 
 /* Perl-specific SWIG API */
@@ -141,8 +141,6 @@ typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
 #endif /* MULTIPLICITY */
 #endif /* PERL_OBJECT */
 
-/* Workaround for bug in perl 5.6.x croak and earlier */
-#if (PERL_VERSION < 8)
 #  ifdef PERL_OBJECT
 #    define SWIG_croak_null() SWIG_Perl_croak_null(pPerl)
 static void SWIG_Perl_croak_null(CPerlObj *pPerl)
@@ -150,17 +148,16 @@ static void SWIG_Perl_croak_null(CPerlObj *pPerl)
 static void SWIG_croak_null()
 #  endif
 {
-  SV *err=ERRSV;
+  SV *err = get_sv("@", GV_ADD);
 #  if (PERL_VERSION < 6)
   croak("%_", err);
 #  else
-  if (SvOK(err) && !SvROK(err)) croak("%_", err);
-  croak(Nullch);
+  if (sv_isobject(err))
+    croak(0);
+  else
+    croak("%s", SvPV_nolen(err));
 #  endif
 }
-#else
-#  define SWIG_croak_null() croak(Nullch)
-#endif
 
 
 /* 
diff --git a/Lib/perl5/perltypemaps.swg b/Lib/perl5/perltypemaps.swg
index 540974476..5df456fd7 100644
--- a/Lib/perl5/perltypemaps.swg
+++ b/Lib/perl5/perltypemaps.swg
@@ -69,7 +69,7 @@
 %end_block %enddef
 
 /* raise exception */
-%define %raise(obj, type, desc) sv_setsv(GvSV(PL_errgv), obj); SWIG_fail %enddef
+%define %raise(obj, type, desc) sv_setsv(get_sv("@", GV_ADD), obj); SWIG_fail %enddef
 
 /* Include the unified typemap library */
 %include <typemaps/swigtypemaps.swg>