Get rid of ‘Not a format reference’
authorFather Chrysostomos <sprout@cpan.org>
Thu, 24 May 2012 19:17:02 +0000 (12:17 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 7 Jun 2012 15:18:50 +0000 (08:18 -0700)
This commit:

commit 2dd78f96d61cc6382dc72214930c993567209597
Author: Jarkko Hietaniemi <jhi@iki.fi>
Date:   Sun Aug 6 01:33:55 2000 +0000

    Continue fixing the io warnings.  This also
    sort of fixes bug ID 20000802.003: the core dump
    is no more.  Whether the current behaviour is correct
    (giving a warning: "Not a format reference"), is another matter.

    p4raw-id: //depot/perl@6531

added a check to see whether the format GV’s name is null, and, if
so, it dies with ‘Not a format reference’.  Before that, that message
occurred only for lack of a GV.

The bug mentioned is now #3617, involving write(*STDOUT{IO}).  write
puts an implicit *{} around its argument.

*{$io} has historically been very buggy in its stringification, so
this patch seems to have been working around that bugginess, by fall-
ing back to the ‘Not a format reference’ error if the name couldn’t be
determined for ‘Undefined format "foo" called’.

*{$io} was fixed once and for all in 5.16.  It now stringifies as
*foopackage::__ANONIO__.

I don’t think producing a completetly different error based on the
name of the GV (whether it’s "foo" or "") is correct at all.  And the
patch that made it happen was just a fix for a crash that can’t hap-
pen any more.

So the only case that should produce ‘Not a format reference’ is that
in which there is no format GV (fgv).

I can prove that fgv is always set (see below), and has been at least
since 5.000, so that ‘Not a format reference’ actually could never
occur before 2dd78f96d61c.  (Actually, XS code could set PL_defoutgv
to null until the previous commit, but everything would start crashing
as a result, so it has never been done in practice.)

gv_efullname4 always returns a name, so checking SvPOK(tmpsv) is
redundant; checking whether the string buffer begins with a non-null
char is not even correct, as "\0foo" fails that test.

Proof that fgv is always set:

The current (prior to this commit) code in pp_enterwrite is like this:

    if (MAXARG == 0) {
gv = PL_defoutgv;
EXTEND(SP, 1);
    }
    else {
gv = MUTABLE_GV(POPs);
if (!gv)
    gv = PL_defoutgv;
    }

If the stack value is null (which actually can’t happen), PL_defoutgv
is used.  PL_defoutgv can’t be null.

At this point, gv is set to something non-null.

    io = GvIO(gv);
    if (!io) {
RETPUSHNO;
    }

Here we only set fgv to IoFMT_GV(io) if it is non-null.  Otherwise we
use gv, which we know is non-null.

    if (IoFMT_GV(io))
fgv = IoFMT_GV(io);
    else
fgv = gv;

pod/perldiag.pod
pp_sys.c
t/op/write.t

index 01b9202..2a486bb 100644 (file)
@@ -3186,11 +3186,6 @@ subroutine), but found a reference to something else instead.  You can
 use the ref() function to find out what kind of ref it really was.  See
 also L<perlref>.
 
-=item Not a format reference
-
-(F) I'm not sure how you managed to generate a reference to an anonymous
-format, but this indicates you did, and that it didn't exist.
-
 =item Not a GLOB reference
 
 (F) Perl was trying to evaluate a reference to a "typeglob" (that is, a
index 5003282..0071e3b 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1361,18 +1361,13 @@ PP(pp_enterwrite)
     else
        fgv = gv;
 
-    if (!fgv)
-       goto not_a_format_reference;
+    assert(fgv);
 
     cv = GvFORM(fgv);
     if (!cv) {
        tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
-       if (SvPOK(tmpsv) && *SvPV_nolen_const(tmpsv))
-           DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
-
-       not_a_format_reference:
-       DIE(aTHX_ "Not a format reference");
+       DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
     return doform(cv,gv,PL_op->op_next);
index 8be0b41..4d63a98 100644 (file)
@@ -504,7 +504,7 @@ for my $tref ( @NumTests ){
 {
     local $~ = '';
     eval { write };
-    like $@, qr/Not a format reference/, 'format reference';
+    like $@, qr/Undefined format ""/, 'format with 0-length name';
 
     $~ = "NOSUCHFORMAT";
     eval { write };