strange race condition when using prototypes

[oodler577]

Module:
Perl subroutine prototypes / Dispatch::Fu

Description
I had to make this change in Dispatch::Fu in order to reliably populate $DISPATCH_TABLE. The bug was triggered when running dispatch in a loop. Here's the commit to the change I had to make in Dispatch::Fu - it should be clear what the change is, it's not complicated but I am happy to clarify further. I've published 1.00 to CPAN since.

oodler577/p5-Dispatch-Fu@1a4fdb9

Steps to Reproduce

• install Dispatch::Fu 0.99
• run this code:

use strict;
use warnings;
use Dispatch::Fu;

sub get_child() {
  return (qw/al grant mary salve/);
};

my (@teddybear, @rockinghorse, @jackinthebox, @gijoe, @barbie, @sallytalksalot, @teaset, @dollhouse);

foreach my $CHILD ( get_child() ) {
  dispatch {
    my $_CHILD   = shift;
print qq{$_CHILD\n};
    my $coinflip = int rand 2;
    return q{A_F_0} if ($_CHILD =~ m/^[a-fA-F]/ and $coinflip == 0);
    return q{A_F_1} if ($_CHILD =~ m/^[a-fA-F]/ and $coinflip == 1);
    return q{G_L_0} if ($_CHILD =~ m/^[g-lG-L]/ and $coinflip == 0);
    return q{G_L_1} if ($_CHILD =~ m/^[g-lG-L]/ and $coinflip == 1);
    return q{M_R_0} if ($_CHILD =~ m/^[m-rM-R]/ and $coinflip == 0);
    return q{M_R_1} if ($_CHILD =~ m/^[m-rM-R]/ and $coinflip == 1);
    return q{S_Z_0} if ($_CHILD =~ m/^[s-zS-Z]/ and $coinflip == 0);
    return q{S_Z_1} if ($_CHILD =~ m/^[s-zS-Z]/ and $coinflip == 1);
  } $CHILD,
    on A_F_0 => sub { push @teddybear,      shift },
    on A_F_1 => sub { push @dollhouse,      shift },
    on G_L_0 => sub { push @rockinghorse,   shift },
    on G_L_1 => sub { push @teaset,         shift },
    on M_R_0 => sub { push @jackinthebox,   shift },
    on M_R_1 => sub { push @sallytalksalot, shift },
    on S_Z_0 => sub { push @gijoe,          shift };
    on S_Z_1 => sub { push @barbie,         shift };
}

use Data::Dumper;
print Data::Dumper::Dumper(\@barbie);

Expected behavior
Expected behavior is that the $DISPATCH_TABLE variable would be populated but the k/v s accumulated via on (in Dispatch/Fu.pm) all the time, not just 75% of the time. Seems like a weird race condition between prototypes and what I'm doing in Dispatch::Fu.

Perl configuration

# perl -V output goes here
Summary of my perl5 (revision 5 version 36 subversion 0) configuration:
   
  Platform:
    osname=linux
    osvers=4.19.0-17-amd64
    archname=x86_64-linux
    uname='linux ma.sdf.org 4.19.0-17-amd64 #1 smp debian 4.19.194-3 (2021-07-18) x86_64 gnulinux '
    config_args='-de -Dprefix=/meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0 -Aeval:scriptdir=/meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/bin'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=undef
    usemultiplicity=undef
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
  Compiler:
    cc='cc'
    ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
    optimize='-O2'
    cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='8.3.0'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='cc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/x86_64-linux-gnu /usr/lib /usr/lib64
    libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.28.so
    so=so
    useshrplib=false
    libperl=libperl.a
    gnulibc_version='2.28'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'


Characteristics of this binary (from libperl): 
  Compile-time options:
    HAS_TIMES
    PERLIO_LAYERS
    PERL_COPY_ON_WRITE
    PERL_DONT_CREATE_GVSV
    PERL_MALLOC_WRAP
    PERL_OP_PARENT
    PERL_PRESERVE_IVUV
    USE_64_BIT_ALL
    USE_64_BIT_INT
    USE_LARGE_FILES
    USE_LOCALE
    USE_LOCALE_COLLATE
    USE_LOCALE_CTYPE
    USE_LOCALE_NUMERIC
    USE_LOCALE_TIME
    USE_PERLIO
    USE_PERL_ATOF
  Built under linux
  Compiled at Jun  5 2022 02:01:49
  %ENV:
    PERLBREW_HOME="/meta/p/perlfan/.perlbrew"
    PERLBREW_MANPATH="/meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/man"
    PERLBREW_PATH="/meta/p/perlfan/perl5/perlbrew/bin:/meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/bin"
    PERLBREW_PERL="perl-5.36.0"
    PERLBREW_ROOT="/meta/p/perlfan/perl5/perlbrew"
    PERLBREW_SHELLRC_VERSION="0.88"
    PERLBREW_VERSION="0.88"
  @INC:
    /meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/lib/site_perl/5.36.0/x86_64-linux
    /meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/lib/site_perl/5.36.0
    /meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/lib/5.36.0/x86_64-linux
    /meta/p/perlfan/perl5/perlbrew/perls/perl-5.36.0/lib/5.36.0

[mauke]

FWIW, I can't tell what "Expected behavior is that the $DISPATCH_TABLE variable would be populated but the k/v s accumulated via on (in Dispatch/Fu.pm) all the time, not just 75% of the time" means. (Also, there is no $DISPATCH_TABLE variable in that code.)

[tonycoz]

Also, there is no $DISPATCH_TABLE variable in that code.

It's in Dispatch::Fu.

The list of on() is parsed as on(key => sub, on(key, sub, on(key, sub, ...))) and prior to the bug fix in 1.000 on() simply returned its arguments, ie. key => sub, key => sub, key => sub, ... which dispatch() then used to populate $DISPATCH_TABLE.

I think the problem is this line:

    on S_Z_0 => sub { push @gijoe,          shift };  # <== this should be a comma.
    on S_Z_1 => sub { push @barbie,         shift };

It only works with the ; in the updated code because the trailing on() populates S_Z_1 in $DISPATCH_TABLE, which is then available the next time around the loop.

If I move salve to the beginning of the list and use Dispatch::Fu 1.000 it fails fairly quickly.

So a bug in the code supplied, not in Dispatch::Fu and not in perl that I can see.

[tonycoz]

It might be worth having on() warn in non-list context, which would catch this issue in user code.

[oodler577]

FWIW, I can't tell what "Expected behavior is that the $DISPATCH_TABLE variable would be populated but the k/v s accumulated via on (in Dispatch/Fu.pm) all the time, not just 75% of the time" means. (Also, there is no $DISPATCH_TABLE variable in that code.)

Sorry that's referencing the module code.

@tonycoz - that was it, thanks for spotting that!!