Fix bug 20020517.003 : segfault with caller().

Add regression tests for caller.

p4raw-id: //depot/perl@16658

MANIFEST

@@ -2441,6 +2441,7 @@ t/op/auto.t			See if autoincrement et all work
 t/op/avhv.t			See if pseudo-hashes work
 t/op/bless.t			See if bless works
 t/op/bop.t			See if bitops work
+t/op/caller.t			See if caller() works
 t/op/chars.t			See if character escapes work
 t/op/chdir.t			See if chdir works
 t/op/chop.t			See if chop works

pp_ctl.c

@@ -1450,11 +1450,18 @@ PP(pp_caller)
     if (!MAXARG)
 	RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+	GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
 	/* So is ccstack[dbcxix]. */
-	sv = NEWSV(49, 0);
-	gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
-	PUSHs(sv_2mortal(sv));
-	PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+	if (isGV(cvgv)) {
+	    sv = NEWSV(49, 0);
+	    gv_efullname3(sv, cvgv, Nullch);
+	    PUSHs(sv_2mortal(sv));
+	    PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+	}
+	else {
+	    PUSHs(sv_2mortal(newSVpvn("(unknown)",9)));
+	    PUSHs(sv_2mortal(newSViv(0)));
+	}
     }
     else {
 	PUSHs(sv_2mortal(newSVpvn("(eval)",6)));

t/op/caller.t

@@ -0,0 +1,46 @@
+#!./perl
+# Tests for caller()
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan( tests => 9 );
+
+my @c;
+
+@c = caller(0);
+ok( (!@c), "caller(0) in main program" );
+
+eval { @c = caller(0) };
+is( $c[3], "(eval)", "caller(0) - subroutine name in an eval {}" );
+
+eval q{ @c = (Caller(0))[3] };
+is( $c[3], "(eval)", "caller(0) - subroutine name in an eval ''" );
+
+sub { @c = caller(0) } -> ();
+is( $c[3], "main::__ANON__", "caller(0) - anonymous subroutine name" );
+
+# Bug 20020517.003, used to dump core
+sub foo { @c = caller(0) }
+my $fooref = delete $::{foo};
+$fooref -> ();
+is( $c[3], "(unknown)", "caller(0) - unknown subroutine name" );
+
+sub f { @c = caller(1) }
+
+eval { f() };
+is( $c[3], "(eval)", "caller(1) - subroutine name in an eval {}" );
+
+eval q{ f() };
+is( $c[3], "(eval)", "caller(1) - subroutine name in an eval ''" );
+
+sub { f() } -> ();
+is( $c[3], "main::__ANON__", "caller(1) - anonymous subroutine name" );
+
+sub foo2 { f() }
+my $fooref2 = delete $::{foo2};
+$fooref2 -> ();
+is( $c[3], "(unknown)", "caller(1) - unknown subroutine name" );