From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 17 Nov 1998 08:28:26 +0000 (+0000)
Subject: propagate failures in DESTROY() as (optional) warnings
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a99e4ac224ca891463a7704e48b83906ece3bb7c;p=p5sagit%2Fp5-mst-13.2.git

propagate failures in DESTROY() as (optional) warnings

p4raw-id: //depot/perl@2245
---

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 4e09da0..29ed897 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -143,6 +143,18 @@ Perl yourself.
 instead of Perl.  Check the #! line, or manually feed your script
 into Perl yourself.
 
+=item         (in cleanup) %s
+
+(W) This prefix usually indicates that a DESTROY() method raised
+the indicated exception.  Since destructors are usually called by
+the system at arbitrary points during execution, and often a vast
+number of times, the warning is issued only once for any number
+of failures that would otherwise result in the same message being
+repeated.
+
+Failure of user callbacks dispatched using the C<G_KEEPERR> flag
+could also result in this warning.  See L<perlcall/G_KEEPERR>.
+
 =item         (Missing semicolon on previous line?)
 
 (S) This is an educated guess made in conjunction with the message "%s
diff --git a/pp_ctl.c b/pp_ctl.c
index 0f02c66..e4b8a73 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1253,6 +1253,8 @@ die_where(char *message)
 			SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
 			sv_catpvn(err, prefix, sizeof(prefix)-1);
 			sv_catpvn(err, message, klen);
+			if (ckWARN(WARN_UNSAFE))
+			    warner(WARN_UNSAFE, SvPVX(err));
 		    }
 		    sv_inc(*svp);
 		}
diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
index 4f17f1f..70c67fa 100644
--- a/t/pragma/warn/pp_ctl
+++ b/t/pragma/warn/pp_ctl
@@ -53,6 +53,10 @@
 	 
 	goto &fred()
 
+      (in cleanup) foo bar
+	package Foo;
+	DESTROY { die "foo bar" }
+	{ bless [], 'Foo' for 1..10 }
 
 __END__
 # pp_ctl.c
@@ -143,3 +147,11 @@ sub fred
 goto &fred()
 EXPECT
 Deep recursion on subroutine "main::fred" at - line 6.
+########
+# pp_ctl.c
+use warning 'unsafe' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+EXPECT
+	(in cleanup) A foo bar at - line 4.