Generate magic_names in dump.c using mg_vtable.pl.

diff --git a/MANIFEST b/MANIFEST
index d482674..5e042bc 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4125,6 +4125,7 @@ metaconfig.SH                     Control file for the metaconfig process
 META.yml                       Distribution meta-data in YAML
 mg.c                           Magic code
 mg.h                           Magic header
+mg_names.c                     Generated magic names used by dump.c
 mg_raw.h                       Generated magic data used by generate_uudmap.c
 mg_vtable.h                    Generated magic vtable data
 minimod.pl                     Writes lib/ExtUtils/Miniperl.pm

diff --git a/dump.c b/dump.c
index 8165a7a..f9556c3 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1233,49 +1233,7 @@ Perl_gv_dump(pTHX_ GV *gv)
  */
 
 static const struct { const char type; const char *name; } magic_names[] = {
-       { PERL_MAGIC_sv,             "sv(\\0)" },
-       { PERL_MAGIC_arylen,         "arylen(#)" },
-       { PERL_MAGIC_rhash,          "rhash(%)" },
-       { PERL_MAGIC_pos,            "pos(.)" },
-       { PERL_MAGIC_symtab,         "symtab(:)" },
-       { PERL_MAGIC_backref,        "backref(<)" },
-       { PERL_MAGIC_arylen_p,       "arylen_p(@)" },
-       { PERL_MAGIC_overload,       "overload(A)" },
-       { PERL_MAGIC_bm,             "bm(B)" },
-       { PERL_MAGIC_regdata,        "regdata(D)" },
-       { PERL_MAGIC_env,            "env(E)" },
-       { PERL_MAGIC_hints,          "hints(H)" },
-       { PERL_MAGIC_isa,            "isa(I)" },
-       { PERL_MAGIC_dbfile,         "dbfile(L)" },
-       { PERL_MAGIC_shared,         "shared(N)" },
-       { PERL_MAGIC_tied,           "tied(P)" },
-       { PERL_MAGIC_sig,            "sig(S)" },
-       { PERL_MAGIC_uvar,           "uvar(U)" },
-       { PERL_MAGIC_checkcall,      "checkcall(])" },
-       { PERL_MAGIC_overload_elem,  "overload_elem(a)" },
-       { PERL_MAGIC_overload_table, "overload_table(c)" },
-       { PERL_MAGIC_regdatum,       "regdatum(d)" },
-       { PERL_MAGIC_envelem,        "envelem(e)" },
-       { PERL_MAGIC_fm,             "fm(f)" },
-       { PERL_MAGIC_regex_global,   "regex_global(g)" },
-       { PERL_MAGIC_hintselem,      "hintselem(h)" },
-       { PERL_MAGIC_isaelem,        "isaelem(i)" },
-       { PERL_MAGIC_nkeys,          "nkeys(k)" },
-       { PERL_MAGIC_dbline,         "dbline(l)" },
-       { PERL_MAGIC_shared_scalar,  "shared_scalar(n)" },
-       { PERL_MAGIC_collxfrm,       "collxfrm(o)" },
-       { PERL_MAGIC_tiedelem,       "tiedelem(p)" },
-       { PERL_MAGIC_tiedscalar,     "tiedscalar(q)" },
-       { PERL_MAGIC_qr,             "qr(r)" },
-       { PERL_MAGIC_sigelem,        "sigelem(s)" },
-       { PERL_MAGIC_taint,          "taint(t)" },
-       { PERL_MAGIC_uvar_elem,      "uvar_elem(u)" },
-       { PERL_MAGIC_vec,            "vec(v)" },
-       { PERL_MAGIC_vstring,        "vstring(V)" },
-       { PERL_MAGIC_utf8,           "utf8(w)" },
-       { PERL_MAGIC_substr,         "substr(x)" },
-       { PERL_MAGIC_defelem,        "defelem(y)" },
-       { PERL_MAGIC_ext,            "ext(~)" },
+#include "mg_names.c"
        /* this null string terminates the list */
        { 0,                         NULL },
 };

diff --git a/mg_names.c b/mg_names.c
new file mode 100644 (file)
index 0000000..1287a00
--- /dev/null
+++ b/mg_names.c
@@ -0,0 +1,53 @@
+/* -*- buffer-read-only: t -*-
+ *
+ *    mg_names.c
+ * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+ * This file is built by regen/mg_vtable.pl.
+ * Any changes made here will be lost!
+ */
+
+       { PERL_MAGIC_sv,             "sv(\\0)" },
+       { PERL_MAGIC_overload,       "overload(A)" },
+       { PERL_MAGIC_overload_elem,  "overload_elem(a)" },
+       { PERL_MAGIC_overload_table, "overload_table(c)" },
+       { PERL_MAGIC_bm,             "bm(B)" },
+       { PERL_MAGIC_regdata,        "regdata(D)" },
+       { PERL_MAGIC_regdatum,       "regdatum(d)" },
+       { PERL_MAGIC_env,            "env(E)" },
+       { PERL_MAGIC_envelem,        "envelem(e)" },
+       { PERL_MAGIC_fm,             "fm(f)" },
+       { PERL_MAGIC_regex_global,   "regex_global(g)" },
+       { PERL_MAGIC_hints,          "hints(H)" },
+       { PERL_MAGIC_hintselem,      "hintselem(h)" },
+       { PERL_MAGIC_isa,            "isa(I)" },
+       { PERL_MAGIC_isaelem,        "isaelem(i)" },
+       { PERL_MAGIC_nkeys,          "nkeys(k)" },
+       { PERL_MAGIC_dbfile,         "dbfile(L)" },
+       { PERL_MAGIC_dbline,         "dbline(l)" },
+       { PERL_MAGIC_shared,         "shared(N)" },
+       { PERL_MAGIC_shared_scalar,  "shared_scalar(n)" },
+       { PERL_MAGIC_collxfrm,       "collxfrm(o)" },
+       { PERL_MAGIC_tied,           "tied(P)" },
+       { PERL_MAGIC_tiedelem,       "tiedelem(p)" },
+       { PERL_MAGIC_tiedscalar,     "tiedscalar(q)" },
+       { PERL_MAGIC_qr,             "qr(r)" },
+       { PERL_MAGIC_sig,            "sig(S)" },
+       { PERL_MAGIC_sigelem,        "sigelem(s)" },
+       { PERL_MAGIC_taint,          "taint(t)" },
+       { PERL_MAGIC_uvar,           "uvar(U)" },
+       { PERL_MAGIC_uvar_elem,      "uvar_elem(u)" },
+       { PERL_MAGIC_vec,            "vec(v)" },
+       { PERL_MAGIC_vstring,        "vstring(V)" },
+       { PERL_MAGIC_utf8,           "utf8(w)" },
+       { PERL_MAGIC_substr,         "substr(x)" },
+       { PERL_MAGIC_defelem,        "defelem(y)" },
+       { PERL_MAGIC_arylen,         "arylen(#)" },
+       { PERL_MAGIC_pos,            "pos(.)" },
+       { PERL_MAGIC_backref,        "backref(<)" },
+       { PERL_MAGIC_symtab,         "symtab(:)" },
+       { PERL_MAGIC_rhash,          "rhash(%)" },
+       { PERL_MAGIC_arylen_p,       "arylen_p(@)" },
+       { PERL_MAGIC_ext,            "ext(~)" },
+       { PERL_MAGIC_checkcall,      "checkcall(])" },
+
+/* ex: set ro: */

diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index c8b6852..dc3fb78 100644 (file)
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -18,9 +18,6 @@ BEGIN {
     require 'regen/regen_lib.pl';
 }
 
-# Update the magic_names table in dump.c when adding/amending these
-# (effectively, that's a TODO)
-
 my @mg =
     (
      sv => { char => '\0', vtable => 'sv', readonly_acceptable => 1,
@@ -144,10 +141,10 @@ my @sig =
      'hints' => {clear => 'clearhints'},
 );
 
-my ($vt, $raw) = map {
+my ($vt, $raw, $names) = map {
     open_new($_, '>',
             { by => 'regen/mg_vtable.pl', file => $_, style => '*' });
-} 'mg_vtable.h', 'mg_raw.h';
+} 'mg_vtable.h', 'mg_raw.h', 'mg_names.c';
 
 print $vt <<'EOH';
 /* These constants should be used in preference to raw characters
@@ -173,6 +170,8 @@ foreach (grep {!ref $_} @mg) {
 # predictable)
 
 {
+    my $longest_p1 = $longest + 1;
+
     while (my ($name, $data) = splice @mg, 0, 2) {
        my $i = ord eval qq{"$data->{char}"};
        unless ($data->{unknown_to_sv_magic}) {
@@ -192,6 +191,11 @@ foreach (grep {!ref $_} @mg) {
        $comment =~ s/\n/\n$leader/s;
        printf $vt "#define PERL_MAGIC_%-${longest}s '%s' /* %s */\n",
            $name, $data->{char}, $comment;
+
+       my $char = $data->{char};
+       $char =~ s/([\\"])/\\$1/g;
+       printf $names qq[\t{ PERL_MAGIC_%-${longest_p1}s "%s(%s)" },\n],
+           "$name,", $name, $char;
     }
 }
 
@@ -283,4 +287,4 @@ print $vt "#define PL_vtbl_$_ PL_magic_vtables[want_vtbl_$_]\n"
 # 63, not 64, As we rely on the last possible value to mean "NULL vtable"
 die "Too many vtable names" if @vtable_names > 63;
 
-read_only_bottom_close_and_rename($_) foreach $vt, $raw;
+read_only_bottom_close_and_rename($_) foreach $vt, $raw, $names;

diff --git a/t/porting/regen.t b/t/porting/regen.t
index b644d70..bbfb497 100644 (file)
--- a/t/porting/regen.t
+++ b/t/porting/regen.t
@@ -27,7 +27,7 @@ if ( $^O eq "VMS" ) {
   skip_all( "- regen.pl needs porting." );
 }
 
-my $in_regen_pl = 19; # I can't see a clean way to calculate this automatically.
+my $in_regen_pl = 20; # I can't see a clean way to calculate this automatically.
 my @files = qw(perly.act perly.h perly.tab keywords.c keywords.h uconfig.h);
 my @progs = qw(Porting/makemeta regen/regcharclass.pl regen/mk_PL_charclass.pl);