Change Constant(undef) error to something meaningful

Look at these errors:

$ perl5.16.0 -e 'use overload; BEGIN{overload::constant q => sub{}; } "aaa"'
Constant(q): Call to &{$^H{q}} did not return a defined value at -e line 1, near "} "aaa""
Execution of -e aborted due to compilation errors.

$ perl5.16.0 -e 'BEGIN{++$_ for @INC{<charnames.pm _charnames.pm>}} "\N{a}"'
Constant(\N{a}) unknown at -e line 1, within string
Execution of -e aborted due to compilation errors.

$ perl5.16.0 -e 'use overload; BEGIN{overload::constant q => sub{}; } tr"aaa""'
Constant(tr): Call to &{$^H{q}} did not return a defined value at -e line 1, within string
Execution of -e aborted due to compilation errors.

The (q) and (tr) might seem a bit odd, but are not completely meaning-
less.  They match the third argument passed to the overload handler.
Now look at this:

$ perl5.16.0 -e 'use overload; BEGIN{overload::constant integer => sub{}; } 123'
Constant(undef): Call to &{$^H{integer}} did not return a defined value at -e line 1, at end of line
Execution of -e aborted due to compilation errors.

$ perl5.16.0 -e 'use overload; BEGIN{overload::constant float => sub{}; } 1.23'
Constant(undef): Call to &{$^H{float}} did not return a defined value at -e line 1, at end of line
Execution of -e aborted due to compilation errors.

$ perl5.16.0 -e 'use overload; BEGIN{overload::constant binary => sub{}; } 0x123'
Constant(undef): Call to &{$^H{binary}} did not return a defined value at -e line 1, at end of line
Execution of -e aborted due to compilation errors.

That Constant(undef) is not helpful.  This commit changes it to show
the number itself, making these cases similar to \N{}.

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index cd1fc20..329e12c 100644 (file)
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -33,7 +33,7 @@ use overload;
 BEGIN { overload::constant integer => sub {}; undef *^H }
 1
 EXPECT
-Constant(undef) unknown at - line 3, at end of line
+Constant(1) unknown at - line 3, at end of line
 Execution of - aborted due to compilation errors.
 ########
 # NAME Float constant overloading returning undef
@@ -41,7 +41,7 @@ use overload;
 BEGIN { overload::constant float => sub {}; undef *^H }
 1.1
 EXPECT
-Constant(undef) unknown at - line 3, at end of line
+Constant(1.1) unknown at - line 3, at end of line
 Execution of - aborted due to compilation errors.
 ########
 # NAME Binary constant overloading returning undef
@@ -49,7 +49,7 @@ use overload;
 BEGIN { overload::constant binary => sub {}; undef *^H }
 0x1
 EXPECT
-Constant(undef) unknown at - line 3, at end of line
+Constant(0x1) unknown at - line 3, at end of line
 Execution of - aborted due to compilation errors.
 ########
 # NAME String constant overloading returning undef
@@ -84,7 +84,7 @@ use overload;
 BEGIN { overload::constant integer => sub {} }
 1
 EXPECT
-Constant(undef): Call to &{$^H{integer}} did not return a defined value at - line 3, at end of line
+Constant(1): Call to &{$^H{integer}} did not return a defined value at - line 3, at end of line
 Execution of - aborted due to compilation errors.
 ########
 # NAME Float constant overloading returning undef
@@ -92,7 +92,7 @@ use overload;
 BEGIN { overload::constant float => sub {} }
 1.1
 EXPECT
-Constant(undef): Call to &{$^H{float}} did not return a defined value at - line 3, at end of line
+Constant(1.1): Call to &{$^H{float}} did not return a defined value at - line 3, at end of line
 Execution of - aborted due to compilation errors.
 ########
 # NAME Binary constant overloading returning undef
@@ -100,7 +100,7 @@ use overload;
 BEGIN { overload::constant binary => sub {} }
 0x1
 EXPECT
-Constant(undef): Call to &{$^H{binary}} did not return a defined value at - line 3, at end of line
+Constant(0x1): Call to &{$^H{binary}} did not return a defined value at - line 3, at end of line
 Execution of - aborted due to compilation errors.
 ########
 # NAME String constant overloading returning undef

diff --git a/toke.c b/toke.c
index 26057a5..423bebc 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -9031,6 +9031,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
     PERL_ARGS_ASSERT_NEW_CONSTANT;
     /* We assume that this is true: */
     if (*key == 'c') { assert (strEQ(key, "charnames")); }
+    assert(type || s);
 
     /* charnames doesn't work well if there have been errors found */
     if (PL_error_count > 0 && *key == 'c')
@@ -9071,7 +9072,9 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
        }
        if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
            msg = Perl_newSVpvf(aTHX_
-                           "Constant(%s) unknown", (type ? type: "undef"));
+                              "Constant(%.*s) unknown",
+                               (int)(type ? typelen : len),
+                               (type ? type: s));
        }
        else {
             why1 = "$^H{";
@@ -9087,8 +9090,9 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
                 return sv;
             }
             else {
-                msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s",
-                                (type ? type: "undef"), why1, why2, why3);
+                msg = Perl_newSVpvf(aTHX_ "Constant(%.*s): %s%s%s",
+                                    (int)(type ? typelen : len),
+                                    (type ? type: s), why1, why2, why3);
             }
         }
        yyerror(SvPVX_const(msg));