develooper Front page | perl.perl5.porters | Postings from July 2001

[PATCH] More accurate line numbers in messages

From:
Paul Johnson
Date:
July 11, 2001 18:10
Subject:
[PATCH] More accurate line numbers in messages
Message ID:
20010712041411.A3467@pjcj.net
Here's something that might allow a few bugs to be closed.

We often get bug reports stating that error messages are reported giving
the wrong line number.  This happens when COPs are optimised away, but
the data is still there if we look hard enough.

This program


    #!/usr/bin/perl -w

    $x = 1;

    if ($x)
    {
        print $y;
    }

currently reports

    Name "main::y" used only once: possible typo at prog line 7.
    Use of uninitialized value in print at prog line 5.

After this patch it gives

    Name "main::y" used only once: possible typo at prog line 7.
    Use of uninitialized value in print at prog line 7.

I've also added this info to the -Dx output, but I haven't touched
B::Concise.  The patch passes all tests, so I've added some which would
have failed.

Just taking a break from job hunting :-)



--- util.c.org	Thu Jul  5 03:54:42 2001
+++ util.c	Thu Jul 12 03:26:02 2001
@@ -1003,17 +1003,59 @@
     return retval;
 }
 
+static COP *closest_cop(COP *cop, OP *o)
+{
+    /* Look for PL_op starting from o.  cop is the last COP we've seen. */
+
+    if (!o || o == PL_op) return cop;
+
+    if (o->op_flags & OPf_KIDS) {
+	OP *kid;
+	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
+	{
+	    COP *new_cop;
+
+	    /* If the OP_NEXTSTATE has been optimised away we can still use it
+	     * the get the file and line number. */
+
+	    if (kid->op_type == OP_NULL && kid->op_targ == OP_NEXTSTATE)
+		cop = (COP *)kid;
+
+	    /* Keep searching, and return when we've found something. */
+
+	    new_cop = closest_cop(cop, kid);
+	    if (new_cop) return new_cop;
+	}
+    }
+
+    /* Nothing found. */
+
+    return 0;
+}
+
 SV *
 Perl_vmess(pTHX_ const char *pat, va_list *args)
 {
     SV *sv = mess_alloc();
     static char dgd[] = " during global destruction.\n";
+    COP *cop;
 
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
-	if (CopLINE(PL_curcop))
+
+	/*
+	 * Try and find the file and line for PL_op.  This will usually be
+	 * PL_curcop, but it might be a cop that has been optimised away.  We
+	 * can try to find such a cop by searching through the optree starting
+	 * from the sibling of PL_curcop.
+	 */
+
+	cop = closest_cop(PL_curcop, PL_curcop->op_sibling);
+	if (!cop) cop = PL_curcop;
+
+	if (CopLINE(cop))
 	    Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
-			   CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
+			   CopFILE(cop), (IV)CopLINE(cop));
 	if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
 	    bool line_mode = (RsSIMPLE(PL_rs) &&
 			      SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
--- dump.c.org	Fri Jul  6 04:15:58 2001
+++ dump.c	Thu Jul 12 03:26:02 2001
@@ -392,7 +392,20 @@
 	PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
 	if (o->op_type == OP_NULL)
+	{
 	    Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
+	    if (o->op_targ == OP_NEXTSTATE)
+	    {
+		if (CopLINE(cCOPo))
+		    Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo));
+		if (CopSTASHPV(cCOPo))
+		    Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
+				     CopSTASHPV(cCOPo));
+		if (cCOPo->cop_label)
+		    Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
+				     cCOPo->cop_label);
+	    }
+	}
 	else
 	    Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
     }
--- t/lib/warnings/util.org	Mon Jun 18 16:32:19 2001
+++ t/lib/warnings/util	Thu Jul 12 03:26:02 2001
@@ -106,3 +106,53 @@
    $a =  oct "0047777777777" ;
 EXPECT
 Octal number > 037777777777 non-portable at - line 5.
+########
+# util.c
+use warnings;
+$x = 1;
+if ($x) {
+    print $y;
+}
+EXPECT
+Name "main::y" used only once: possible typo at - line 5.
+Use of uninitialized value in print at - line 5.
+########
+# util.c
+use warnings;
+$x = 1;
+if ($x) {
+    $x++;
+    print $y;
+}
+EXPECT
+Name "main::y" used only once: possible typo at - line 6.
+Use of uninitialized value in print at - line 6.
+########
+# util.c
+use warnings;
+$x = 0;
+if ($x) {
+    print "1\n";
+} elsif (!$x) {
+    print $y;
+} else {
+    print "0\n";
+}
+EXPECT
+Name "main::y" used only once: possible typo at - line 7.
+Use of uninitialized value in print at - line 7.
+########
+# util.c
+use warnings;
+$x = 0;
+if ($x) {
+    print "1\n";
+} elsif (!$x) {
+    $x++;
+    print $y;
+} else {
+    print "0\n";
+}
+EXPECT
+Name "main::y" used only once: possible typo at - line 8.
+Use of uninitialized value in print at - line 8.

-- 
Paul Johnson - paul@pjcj.net
http://www.pjcj.net



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About