[perl #132316] [SEGV] Crash while running program (MongoDB module)

[Zoffix Znet via RT]

On Thu, 26 Oct 2017 06:04:51 -0700, alex.jakime...@gmail.com wrote:
> FWIW, when toasting I observed double free or corruption when
> installing both
> BSON and MongoDB modules. The issue is really there, and should be
> reproducible
> by just running the tests. That said, I've been running BSON tests
> locally in a
> loop for hours with no luck.

I can repro it easily on by Ubuntu box. Golfed it down to the attached code 
running in BSON repo[^1] 
checkout with `while perl6 -Ilib t/300-document.t; do true; done`. I get 
double-free errors as well as 
occasional failing tests.

Briefly glancing at the guts of the module and seeing all the Promises created 
left, right, and center,
it wouldn't surprise me if this issue is due to the BSON module doing 
thread-unsafe things somewhere and
not an issue in rakudo.

[1] https://github.com/MARTIMM/BSON


use v6;
use Test;
use BSON::Document;

#-------------------------------------------------------------------------------
subtest "Initialize document", {

  # Init via Seq
  #
  my BSON::Document $d .= new: ('a' ... 'z') Z=> 120..145;

  is $d<a>, 120, "\$d<a> = $d<a>";
  is $d<b>, 121, "\$d<b> = $d<b>";
  is $d.elems, 26, "{$d.elems} elements";

  # Add one element, encode and decode using new(Buf)
  #
  $d<aaa> = 11;
  my Buf $b2 = $d.encode;
  my BSON::Document $d2 .= new($b2);
  is $d2.elems, 27, "{$d.elems} elements in decoded doc";
  is $d2<aaa>, 11, "Item is $d2<aaa>";

  # Init via list
  #
  $d .= new: (ppp => 100, qqq => ( d => 110, e => 120));
  is $d<ppp>, 100, "\$d<ppp> = $d<ppp>";
  is $d<qqq><d>, 110, "\$d<qqq><d> = $d<qqq><d>";

  # Init via hash inhibited
  throws-like { $d .= new: ppp => 100, qqq => ( d => 110, e => 120); },
    X::BSON, 'Cannot use hashes on init',
    :message(/:s Cannot use hash values on init/);
}

#-------------------------------------------------------------------------------
subtest "Ban the hash", {

  my BSON::Document $d .= new;
  throws-like {
      $d<q> = {a => 20};
      is $d<q><a>, 20, "Hash value $d<q><a>";
    }, X::BSON, 'Cannot use hashes when assigning',
    :message(/:s Cannot use hash values/);

  $d.accept-hash(True);
  $d<q> = {
    a => 120, b => 121, c => 122, d => 123, e => 124, f => 125, g => 126,
    h => 127, i => 128, j => 129, k => 130, l => 131, m => 132, n => 133,
    o => 134, p => 135, q => 136, r => 137, s => 138, t => 139, u => 140,
    v => 141, w => 142, x => 143, y => 144, z => 145
  };
  is $d<q><a>, 120, "Hash value $d<q><a>";
  my $x = $d<q>.keys.sort;
  nok $x eqv $d<q>.keys.List, 'Not same order';

  $d.autovivify(True);

  $d<e><f><g> = {b => 30};
  is $d<e><f><g><b>, 30, "Autovivified hash value $d<e><f><g><b>";
}


#if %*ENV<TRAVIS>:exists or '/home/marcel/Languages/Perl6'.IO ~~ :d {
  subtest "Big, wide and deep nesting", {

    # Keys must be sufficiently long and value complex enough to keep a
    # thread busy causing the process to runout of available threads
    # which are by default 16.
    my Num $count = 0.1e0;
    my BSON::Document $d .= new;
    for ('zxnbcvzbnxvc-aa', *.succ ... 'zxnbcvzbnxvc-bz') -> $char {
      $d{$char} = ($count += 2.44e0);
    }

    my BSON::Document $dsub .= new;
    for ('uqwteuyqwte-aa', *.succ ... 'uqwteuyqwte-bz') -> $char {
      $dsub{$char} = ($count += 2.1e0);
    }

    for ('uqwteuyqwte-da', *.succ ... 'uqwteuyqwte-dz') -> $char {
      $d<x1>{$char} = ($count += 2.1e0);
      $d<x2><x1>{$char} = $dsub.clone;
      $d<x2><x2><x3>{$char} = $dsub.clone;
    }

    for ('jhgsajhgasjdg-ca', *.succ ... 'jhgsajhgasjdg-cz') -> $char {
      $d{$char} = ($count -= 0.02e0);
    }

    for ('uqwteuyqwte-ea', *.succ ... 'uqwteuyqwte-ez') -> $char {
      $d<x3>{$char} = $dsub.clone;
      $d<x4><x1>{$char} = $dsub.clone;
      $d<x4><x2><x3>{$char} = $dsub.clone;
    }

    $dsub .= new($d.encode);
    is-deeply $dsub, $d, 'document the same after encoding/decoding';
  }
#}


done-testing;