Generate the table of core magic types in perlguts.pod using mg_vtable.pl

This fixes a couple of errors and omissions, and resorts the table in the same
case insensitive order as the header files. It eliminates 1 overlong verbatim
line of pod.

As there's no good way to include component files into the core pods, and the
regen scripts aren't designed to modify in place, generate this to STDOUT (if
-g is added to the command line), to be hand edited into place. It would be
nice to be able to automate this fully.

diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index c5ba48e..b32c01d 100644 (file)
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1035,49 +1035,56 @@ The current kinds of Magic Virtual Tables are:
     (old-style char and macro)   MGVTBL          Type of magic
     --------------------------   ------          -------------
     \0 PERL_MAGIC_sv             vtbl_sv         Special scalar variable
+    #  PERL_MAGIC_arylen         vtbl_arylen     Array length ($#ary)
+    %  PERL_MAGIC_rhash          (none)          extra data for restricted
+                                                 hashes
+    .  PERL_MAGIC_pos            vtbl_pos        pos() lvalue
+    :  PERL_MAGIC_symtab         (none)          extra data for symbol tables
+    <  PERL_MAGIC_backref        vtbl_backref    for weak ref data
+    @  PERL_MAGIC_arylen_p       (none)          to move arylen out of XPVAV
     A  PERL_MAGIC_overload       vtbl_amagic     %OVERLOAD hash
     a  PERL_MAGIC_overload_elem  vtbl_amagicelem %OVERLOAD hash element
-    c  PERL_MAGIC_overload_table (none)          Holds overload table (AMT)
-                                                 on stash
-    B  PERL_MAGIC_bm             vtbl_bm         Boyer-Moore (fast string search)
-    D  PERL_MAGIC_regdata        vtbl_regdata    Regex match position data
+    B  PERL_MAGIC_bm             vtbl_regexp     Boyer-Moore 
+                                                 (fast string search)
+    c  PERL_MAGIC_overload_table vtbl_ovrld      Holds overload table 
+                                                 (AMT) on stash
+    D  PERL_MAGIC_regdata        vtbl_regdata    Regex match position data 
                                                  (@+ and @- vars)
     d  PERL_MAGIC_regdatum       vtbl_regdatum   Regex match position data
                                                  element
     E  PERL_MAGIC_env            vtbl_env        %ENV hash
     e  PERL_MAGIC_envelem        vtbl_envelem    %ENV hash element
-    f  PERL_MAGIC_fm             vtbl_fm         Formline ('compiled' format)
+    f  PERL_MAGIC_fm             vtbl_regdata    Formline ('compiled' format)
     g  PERL_MAGIC_regex_global   vtbl_mglob      m//g target / study()ed string
     H  PERL_MAGIC_hints          vtbl_hints      %^H hash
     h  PERL_MAGIC_hintselem      vtbl_hintselem  %^H hash element
     I  PERL_MAGIC_isa            vtbl_isa        @ISA array
     i  PERL_MAGIC_isaelem        vtbl_isaelem    @ISA array element
     k  PERL_MAGIC_nkeys          vtbl_nkeys      scalar(keys()) lvalue
-    L  PERL_MAGIC_dbfile         (none)          Debugger %_<filename
-    l  PERL_MAGIC_dbline         vtbl_dbline     Debugger %_<filename element
-    o  PERL_MAGIC_collxfrm       vtbl_collxfrm   Locale collate transformation
+    L  PERL_MAGIC_dbfile         vtbl_dbline     Debugger %_<filename
+    l  PERL_MAGIC_dbline         (none)          Debugger %_<filename element
+    N  PERL_MAGIC_shared         (none)          Shared between threads
+    n  PERL_MAGIC_shared_scalar  (none)          Shared between threads
+    o  PERL_MAGIC_collxfrm       vtbl_collxfrm   Locale transformation
     P  PERL_MAGIC_tied           vtbl_pack       Tied array or hash
     p  PERL_MAGIC_tiedelem       vtbl_packelem   Tied array or hash element
     q  PERL_MAGIC_tiedscalar     vtbl_packelem   Tied scalar or handle
-    r  PERL_MAGIC_qr             vtbl_qr         precompiled qr// regex
+    r  PERL_MAGIC_qr             vtbl_regexp     precompiled qr// regex
     S  PERL_MAGIC_sig            (none)          %SIG hash
     s  PERL_MAGIC_sigelem        vtbl_sigelem    %SIG hash element
     t  PERL_MAGIC_taint          vtbl_taint      Taintedness
     U  PERL_MAGIC_uvar           vtbl_uvar       Available for use by extensions
+    u  PERL_MAGIC_uvar_elem      (none)          Reserved for use by extensions
+    V  PERL_MAGIC_vstring        (none)          SV was vstring literal
     v  PERL_MAGIC_vec            vtbl_vec        vec() lvalue
-    V  PERL_MAGIC_vstring        (none)          v-string scalars
-    w  PERL_MAGIC_utf8           vtbl_utf8       UTF-8 length+offset cache
+    w  PERL_MAGIC_utf8           vtbl_utf8       Cached UTF-8 information
     x  PERL_MAGIC_substr         vtbl_substr     substr() lvalue
     y  PERL_MAGIC_defelem        vtbl_defelem    Shadow "foreach" iterator
                                                  variable / smart parameter
                                                  vivification
-    #  PERL_MAGIC_arylen         vtbl_arylen     Array length ($#ary)
-    .  PERL_MAGIC_pos            vtbl_pos        pos() lvalue
-    <  PERL_MAGIC_backref        vtbl_backref    back pointer to a weak ref 
+    ]  PERL_MAGIC_checkcall      (none)          inlining/mutation of call to
+                                                 this CV
     ~  PERL_MAGIC_ext            (none)          Available for use by extensions
-    :  PERL_MAGIC_symtab         (none)          hash used as symbol table
-    %  PERL_MAGIC_rhash          (none)          hash used as restricted hash
-    @  PERL_MAGIC_arylen_p       vtbl_arylen_p   pointer to $#a from @a
 
 
 When an uppercase and lowercase letter both exist in the table, then the

diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index bea64ed..65412dc 100644 (file)
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -18,6 +18,9 @@ BEGIN {
     require 'regen/regen_lib.pl';
 }
 
+# This generates the relevant section to paste into perlguts.pod to STDOUT
+my $output_guts = grep { $_ eq '-g' } @ARGV;
+
 my %mg =
     (
      sv => { char => '\0', vtable => 'sv', readonly_acceptable => 1,
@@ -178,6 +181,7 @@ EOH
        $data->{byte} = $byte;
        $mg_order{(uc $byte) . $byte} = $name;
     }
+    my @rows;
     foreach (sort keys %mg_order) {
        my $name = $mg_order{$_};
        my $data = $mg{$name};
@@ -204,6 +208,44 @@ EOH
        $char =~ s/([\\"])/\\$1/g;
        printf $names qq[\t{ PERL_MAGIC_%-${longest_p1}s "%s(%s)" },\n],
            "$name,", $name, $char;
+
+       push @rows, [(sprintf "%-2s PERL_MAGIC_%s", $data->{char}, $name),
+                    $data->{vtable} ? "vtbl_$data->{vtable}" : '(none)',
+                    $data->{desc}];
+    }
+    if ($output_guts) {
+       my @header = ('(old-style char and macro)', 'MGVTBL', 'Type of magic');
+       my @widths = (0, 0);
+       foreach my $row (@rows) {
+           for (0, 1) {
+               $widths[$_] = length $row->[$_]
+                   if length $row->[$_] > $widths[$_];
+           }
+       }
+       my $indent = '    ';
+       my $format
+           = sprintf "$indent%%-%ds%%-%ds%%s\n", $widths[0] + 1, $widths[1] + 1;
+       my $desc_wrap = 80 - (length $indent) - $widths[0] - $widths[1] - 2;
+
+       print $indent . "mg_type\n";
+       printf $format, @header;
+       printf $format, map {'-' x length $_} @header;
+       foreach (@rows) {
+           my ($type, $vtbl, $desc) = @$_;
+           $desc =~ tr/\n/ /;
+           my @cont;
+           if (length $desc > $desc_wrap) {
+               # If it's too long, first split on '(', if there.
+               # [Which, if there, is always short enough, currently.
+               # Make this more robust if that changes]
+               ($desc, @cont) = split /(?=\()/, $desc;
+               if (!@cont) {
+                   ($desc, @cont) = $desc =~ /(.{1,$desc_wrap})(?: |\z)/g
+               }
+           }
+           printf $format, $type, $vtbl, $desc;
+           printf $format, '', '', $_ foreach @cont;
+       }
     }
 }
 

diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat
index d04b8df..7530493 100644 (file)
--- a/t/porting/known_pod_issues.dat
+++ b/t/porting/known_pod_issues.dat
@@ -241,7 +241,7 @@ pod/perlglossary.pod        ? Should you be using L<...> instead of 1
 pod/perlgpl.pod        Verbatim line length including indents exceeds 80 by    50
 pod/perlguts.pod       ? Should you be using F<...> or maybe L<...> instead of 2
 pod/perlguts.pod       ? Should you be using L<...> instead of 1
-pod/perlguts.pod       Verbatim line length including indents exceeds 80 by    27
+pod/perlguts.pod       Verbatim line length including indents exceeds 80 by    26
 pod/perlhack.pod       Verbatim line length including indents exceeds 80 by    1
 pod/perlhacktips.pod   Verbatim line length including indents exceeds 80 by    1
 pod/perlhist.pod       Verbatim line length including indents exceeds 80 by    2