[win32] merge changes#1016,1018 from maintbranch (1017 is n/a)

p4raw-link: @1018 on //depot/maint-5.004/perl: 2140f6165485c56d1f5c5732484d28716b8f4052
p4raw-link: @1016 on //depot/maint-5.004/perl: b2a0fe98888cc8cc9808cbb17ff2b7f00e09ee60

p4raw-id: //depot/win32/perl@1030

diff --git a/pp_sys.c b/pp_sys.c
index fee474f..09d2341 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -324,6 +324,23 @@ PP(pp_die)
        if(tmpsv ? SvROK(tmpsv) : SvROK(error)) {
            if(tmpsv)
                SvSetSV(error,tmpsv);
+           else if(sv_isobject(error)) {
+               HV *stash = SvSTASH(SvRV(error));
+               GV *gv = gv_fetchmethod(stash, "PROPAGATE");
+               if (gv) {
+                   SV *file = sv_2mortal(newSVsv(GvSV(curcop->cop_filegv)));
+                   SV *line = sv_2mortal(newSViv(curcop->cop_line));
+                   EXTEND(SP, 3);
+                   PUSHMARK(SP);
+                   PUSHs(error);
+                   PUSHs(file);
+                   PUSHs(line);
+                   PUTBACK;
+                   perl_call_sv((SV*)GvCV(gv),
+                                G_SCALAR|G_EVAL|G_KEEPERR);
+                   sv_setsv(error,*stack_sp--);
+               }
+           }
            pat = Nullch;
        }
        else {

diff --git a/t/op/die.t b/t/op/die.t
index 795d856..d473ed6 100755 (executable)
--- a/t/op/die.t
+++ b/t/op/die.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..6\n";
+print "1..10\n";
 
 $SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
 
@@ -24,3 +24,20 @@ eval {
     };
     die if $@;
 };
+
+eval {
+    eval {
+       die bless [ 7 ], "Error";
+    };
+    die if $@;
+};
+
+print "not " unless ref($@) eq "Out";
+print "ok 10\n";
+
+package Error;
+
+sub PROPAGATE {
+    print "ok ",$_[0]->[0]++,"\n";
+    bless [$_[0]->[0]], "Out";
+}