Add ability to specify assert() calls in embed.fnc

This allows the removal of the G flag, and the removal of three
customized PERL_ARGS_ASSERT macros.  One of these showed the brittleness
of the old scheme, as after it was written, code was added to improve
the generic versions of these macros, but no one realized to update the
custom one. This can no longer happen.

These commits also improve the error checking of embed.fnc entries; adds
comments and white space

Author: khwilliamson

embed.fnc

@@ -35,7 +35,7 @@
 :		Supported at least since perl-5.23.8, with or without ppport.h.
 :
 : Lines in this file are of the form:
-:    flags|return_type|name|arg1|arg2|...|argN
+:    flags|return_type|name|arg1|arg2|...|argN ( assert(...) )*
 :
 : 'flags' is a string of single letters.  Most of the flags are meaningful only
 : to embed.pl; some only to autodoc.pl, and others only to makedef.pl.  The
@@ -46,6 +46,9 @@
 : A line may be continued onto the next by ending it with a backslash.
 : Leading and trailing whitespace will be ignored in each component.
 :
+: The optional list of asserts is used to customize the generated
+: PERL_ARGS_ASSERT macro.  See AUTOMATIC PARAMETER SANITY CHECKING below
+:
 : Most entries here have a macro created with the entry name.  This presents
 : name space collision potentials which haven't been well thought out, but are
 : now documented here.  In practice this has rarely been an issue.  At least,
@@ -172,6 +175,14 @@
 :	may not be of the correct type. As already mentioned, NOCHECK
 :	suppresses this check.
 :
+:   You can specify your own checking beyond these by adding any number of
+:   assert() calls to any given entry after its final argument.  Whatever you
+:   specify will be added to the ARGS_ASSERT macro for the entry in the order
+:   you've specified, and after all the assertions that already have been
+:   described in this section.  When adding yours, weigh that doing it here
+:   will make it less visible to a maintainer than keeping it in the function
+:   it applies to
+:
 :   Currently, it is optional to include an empty ARGS_ASSERT macro in your
 :   functions.  But a porting test enforces that a non-empty one is included.
 :   The call should be at the top of your function so that the sanity checks
@@ -442,13 +453,6 @@
 :        flag even on a format function is if the format would generate error:
 :        format string argument is not a string type
 :
-:   'G'  Suppress empty PERL_ARGS_ASSERT_foo macro.  Normally such a macro is
-:        generated for all entries for functions 'foo' in this file.  The macro
-:        is empty unless regen/embed.pl deems that there should be assert()
-:        calls to verify the sanity of some or all of foo's arguments.
-:
-:          proto.h: An empty PERL_ARGS_ASSERT macro is not defined
-:
 :   'h'  Hide any documentation that would normally go into perlapi or
 :        perlintern. This is typically used when the documentation is actually
 :        in another pod. If you don't use the 'h', that documentation is
@@ -750,7 +754,8 @@ ARdp	|SSize_t|av_len 	|NN AV *av
 ARdp	|AV *	|av_make	|SSize_t size				\
 				|NN SV **strp
 CRdip	|AV *	|av_new_alloc	|SSize_t size				\
-				|bool zeroflag
+				|bool zeroflag				\
+				assert(size > 0)
 p	|SV *	|av_nonelem	|NN AV *av				\
 				|SSize_t ix
 Adp	|SV *	|av_pop 	|NN AV *av
@@ -2410,7 +2415,7 @@ p	|void	|no_bareword_filehandle 				\
 				|NN const char *fhname
 Tefprv	|void	|noperl_die	|NN const char *pat			\
 				|...
-CGTdp	|void	|noshutdownhook
+CTdp	|void	|noshutdownhook
 Adp	|int	|nothreadhook
 p	|void	|notify_parser_that_encoding_changed
 : Used in perly.y
@@ -4526,11 +4531,12 @@ op	|void	|sv_add_backref |NN SV * const tsv			\
 				|NN SV * const sv
 #endif
 #if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C)
-EGdp	|HV *	|gv_stashsvpvn_cached					\
-				|SV *namesv				\
-				|const char *name			\
+Edp	|HV *	|gv_stashsvpvn_cached					\
+				|NULLOK SV *namesv			\
+				|NULLOK const char *name		\
 				|U32 namelen				\
-				|I32 flags
+				|I32 flags				\
+				assert(namesv || name)
 #endif
 #if defined(PERL_IN_HV_C)
 Sx	|void	|clear_placeholders					\
@@ -6109,17 +6115,19 @@ S	|I32	|utf16_textfilter					\
 # endif
 #endif /* defined(PERL_IN_TOKE_C) */
 #if defined(PERL_IN_UNIVERSAL_C)
-GS	|bool	|isa_lookup	|NULLOK NOCHECK HV *stash		\
+S	|bool	|isa_lookup	|NN HV *stash				\
 				|NULLOK SV *namesv			\
 				|NULLOK const char *name		\
 				|STRLEN len				\
-				|U32 flags
-GS	|bool	|sv_derived_from_svpvn					\
-				|NULLOK SV *sv				\
+				|U32 flags				\
+				assert(namesv || name)
+S	|bool	|sv_derived_from_svpvn					\
+				|NN SV *sv				\
 				|NULLOK SV *namesv			\
 				|NULLOK const char *name		\
 				|const STRLEN len			\
-				|U32 flags
+				|U32 flags				\
+				assert(namesv || name)
 #endif
 #if defined(PERL_IN_UTF8_C)
 RS	|UV	|check_locale_boundary_crossing 			\

gv.c

@@ -1691,17 +1691,14 @@ reasons.
 =cut
 */
 
-#define PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED \
-    assert(namesv || name)
-
 HV*
 Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags)
 {
+    PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED;
+
     HV* stash;
     HE* he;
 
-    PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED;
-
     he = (HE *)hv_common(
         PL_stashcache, namesv, name, namelen,
         (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0

inline.h

@@ -191,10 +191,10 @@ initialized.
 PERL_STATIC_INLINE AV *
 Perl_av_new_alloc(pTHX_ SSize_t size, bool zeroflag)
 {
+    PERL_ARGS_ASSERT_AV_NEW_ALLOC;
+
     AV * const av = newAV();
     SV** ary;
-    PERL_ARGS_ASSERT_AV_NEW_ALLOC;
-    assert(size > 0);
 
     Newx(ary, size, SV*); /* Newx performs the memwrap check */
     AvALLOC(av) = ary;

pod/perldelta.pod

@@ -434,6 +434,19 @@ memory saving is unrealistic.
 C<sv_vcatpvfn_flags()> now substitutes the Unicode REPLACEMENT CHARACTER
 for malformed input.  Previously it used the NUL character.
 
+=item *
+
+For core Perl maintainers, the syntax of F<embed.fnc> has been extended.
+Every function, C<foo()>, named in this file has generated for it a
+macro named C<PERL_ARGS_ASSERT_FOO>.  The macro expands to C<assert()>
+calls that do basic sanity checking for each argument to C<foo()> that
+we currently deem as being appropriate to have such checking.  (That
+means that many arguments are not checked, and that the generated macro
+may currently expand to nothing.)  With this release, you can add
+C<assert()> statements yourself to F<embed.fnc> that will be
+incorporated into the generated macro, beyond the system-generated ones.
+Comments and examples in F<embed.fnc> give details.
+
 =back
 
 =head1 Selected Bug Fixes

proto.h

@@ -737,46 +737,94 @@ sub lines { $_[0]->{lines} }
 sub tidy_embed_fnc_entry {
     my ($self, $line_data)= @_;
     my $line= $line_data->{line};
-    return $line if $line =~ /^\s*:/;
-    return $line unless $line_data->{type} eq "content";
-    return $line unless $line =~ /\|/;
 
-    $line =~ s/\s*\\\n/ /g;
-    $line =~ s/\s+\z//;
-    ($line)= expand($line);
+    return $line if $line =~ /^\s*:/;                    # Don't tidy comments
+    return $line unless $line_data->{type} eq "content"; # Nor #if-like
+    return $line unless $line =~ /\|/;                   # Nor non-entries
+
+    $line =~ s/\s*\\\n/ /g;     # Embedded \n to blank
+    $line =~ s/\s+\z//;         # No trailing white space
+    ($line)= expand($line);     # No tabs
+
+    # Remove any assertions, and save them.  This must be done before the
+    # split because the assertions can contain '|'
+    $line =~ s/ \b ( assert \s* \( .* ) \z //x;
+    my $assertions = $1;
+
+    # Split into fields
     my ($flags, $ret, $name, @args)= split /\s*\|\s*/, $line;
+
+    # Sort and remove duplicate flags.  Alpha flags are sorted first
     my %flag_seen;
-    $flags= join "", grep !$flag_seen{$_}++, sort split //, $flags;
-    if ($flags =~ s/^#//) {
-        $flags .= "#";
-    }
-    if ($flags eq "#") {
+    $flags = join "", grep !$flag_seen{$_}++,
+                      sort {
+                             my $a_is_word = $a =~ /\w/;
+                             my $b_is_word = $b =~ /\w/;
+                             return $a cmp $b if $a_is_word == $b_is_word;
+                             return -1 if $a_is_word;
+                             return  1;
+                           } split //, $flags;
+
+    if ($flags eq "#") {    # Could be an attempt at a conditional
         die "Not allowed to use only '#' for flags"
             . "in 'embed.fnc' at line $line_data->{start_line_num}";
     }
+
     if (!$flags) {
         die "Missing flags in function definition"
             . " in 'embed.fnc' at line $line_data->{start_line_num}\n"
             . "Did you a forget a line continuation on the previous line?\n";
     }
+
+    # Normalize the return type and arguments
     for ($ret, @args) {
         s/(\w)\*/$1 */g;
         s/\*\s+(\w)/*$1/g;
         s/\*const/* const/g;
     }
+
+    # Start the output; right justify
     my $head= sprintf "%-8s|%-7s", $flags, $ret;
     $head .= sprintf "|%*s", -(31 - length($head)), $name;
+
+    # Start first argument on next line if $head already extends too far to
+    # the right
     if (@args and length($head) > 32) {
         $head .= "\\\n";
         $head .= " " x 32;
     }
+
+    # Add each argument on a separate line
     foreach my $ix (0 .. $#args) {
         my $arg= $args[$ix];
         $head .= "|$arg";
         $head .= "\\\n" . (" " x 32) if $ix < $#args;
     }
+
+    my @assertions;
+    if ($assertions) {
+        # Put each assertion into a separate array element
+        @assertions = split / \s* assert \s* \( /x, $assertions;
+        shift @assertions;  # The split leaves an empty first element
+
+        # Trim each assertion, including any trailing semicolon
+        foreach my $this_assertion (@assertions) {
+            $this_assertion =~ s/ ^ \s+  //x;
+            $this_assertion =~ s/ \s+ \z //x;
+            $this_assertion =~ s/ ; \z   //x;
+
+            # Restore split delimitter
+            $this_assertion = "assert($this_assertion";
+
+            # Each assertion is on a separate line (for now, anyway)
+            $head .= "\\\n" . (" " x 32);
+            $head .= $this_assertion;
+        }
+    }
+
     $line= $head . "\n";
 
+    # Make all lines in this entry the same length; minimum 72
     if ($line =~ /\\\n/) {
         my @lines= split /\s*\\\n/, $line;
         my $len= length($lines[0]);
@@ -787,15 +835,18 @@ sub tidy_embed_fnc_entry {
             (map { sprintf "%*s", -$len, $_ } @lines[ 0 .. $#lines - 1 ]),
             $lines[-1]);
     }
-    ($line)= unexpand($line);
+
+    ($line)= unexpand($line);   # Back to using tabs
 
     $line_data->{embed}= EmbedLine->new(
         flags          => $flags,
         return_type    => $ret,
         name           => $name,
         args           => \@args,
+        assertions     => \@assertions,
         start_line_num => $line_data->{start_line_num},
     );
+
     $line =~ s/\s+\z/\n/;
     $line_data->{line}= $line;
     return $line;