embed.pl - the 's', 'S', 'i' and 'I' flags are mutually exclusive

We had a bug where we processed the first one in the flags definition. Sorting
the flags or rearranging them changes the output, which shouldn't happen.

This also fixes the handling and specification of PerlEnv_putenv(), which was
marked "si" when it should have been marked "i". This required changing its
implementation from a Perl_ prefix to a S_ prefix and regenerating.

I have run embed.pl in a loop with a local patch to shuffle the flags to see
if there were any other order dependencies. No output files changed so I
assume with this patch we are free of such bugs.

1 files changed, 16 insertions, 3 deletions

diff --git a/regen/embed.pl b/regen/embed.pl
index 885f7fbe4b..81798816de 100755
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -128,8 +128,21 @@ sub generate_proto_h {
         die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/
                                                             && $flags !~ /m/;
 
+        my ($static_flag, @extra_static_flags)= do {
+            # the seen filter can be removed once flag dedupe
+            # is done in tidy_embed.pl
+            my %seen;
+            grep !$seen{$_}++, $flags =~/([SsIi])/g;
+        };
+
+        if (@extra_static_flags) {
+            my $flags_str = join ", ", $static_flag, @extra_static_flags;
+            $flags_str =~ s/, (\w)\z/ and $1/;
+            die_at_end "$plain_func: flags $flags_str are mutually exclusive\n";
+        }
+
         my $static_inline = 0;
-        if ($flags =~ /([SsIi])/) {
+        if ($static_flag) {
             my $type;
             if ($never_returns) {
                 $type = {
@@ -137,7 +150,7 @@ sub generate_proto_h {
                     's' => 'PERL_STATIC_NO_RET',
                     'i' => 'PERL_STATIC_INLINE_NO_RET',
                     'I' => 'PERL_STATIC_FORCE_INLINE_NO_RET'
-                }->{$1};
+                }->{$static_flag};
             }
             else {
                 $type = {
@@ -145,7 +158,7 @@ sub generate_proto_h {
                     's' => 'STATIC',
                     'i' => 'PERL_STATIC_INLINE',
                     'I' => 'PERL_STATIC_FORCE_INLINE'
-                }->{$1};
+                }->{$static_flag};
             }
             $retval = "$type $retval";
             die_at_end "Don't declare static function '$plain_func' pure" if $flags =~ /P/;