use strict;
use warnings;

sub UNIVERSAL::DESTROY
{
   warn "DESTROYING @_\n";
}

sub dfs
{
    my ($node, $sub) = @_;
    my %visited;

    my $dfs;
    $dfs = sub {
        my ($n) = @_;
        $visited{$n}++;
        $sub->($n);
        for (@$n) {
            next unless ref;
            $dfs->($_->[0]) unless $visited{$_->[0]};
        }
    };

    $dfs->($node);
}

sub do_dfs
{
   my ($node) = @_;
   my $nodes = [];
   my $search = sub { push @$nodes, $_[0] };
   dfs($node,$search);

# UNCOMMENT NEXT LINE to see bug
#  return $nodes;

   my @nodes = @$nodes;
   undef $nodes;
   return [@nodes];
}

warn "STARTING\n";

{
    my $node1 = bless [1], "Node";
    my $node2 = bless [2], "Node";
    push @$node1, bless [$node2], "Link";

    {
       my $nodes = do_dfs($node1);
       warn "Neighbors\n";
       warn "  $_\n" for (@$nodes);
    }
}

warn "SHOULD BE THE LAST THING PRINTED.\n";
[download]

This gives the following expected output:

STARTING
Neighbors
  Node=ARRAY(0x8148a8c)
  Node=ARRAY(0x8148b94)
DESTROYING Node=ARRAY(0x8148a8c) at segfault.pl line 6.
DESTROYING Link=ARRAY(0x818fc00) at segfault.pl line 6.
DESTROYING Node=ARRAY(0x8148b94) at segfault.pl line 6.
SHOULD BE THE LAST THING PRINTED.
[download]

However, uncommenting the indicated line, leads to the follwing output and a segfault.

STARTING
Neighbors
  Node=ARRAY(0x8148a8c)
  Node=ARRAY(0x8148b94)
SHOULD BE THE LAST THING PRINTED.
DESTROYING Node=ARRAY(0x8148a8c) at segfault.pl line 6 during global d
+estruction.
DESTROYING Link=ARRAY(0x818fc48) at segfault.pl line 6 during global d
+estruction.
DESTROYING Node=ARRAY(0x8148b94) at segfault.pl line 6 during global d
+estruction.
DESTROYING IO::Handle=IO(0x818fc6c) at segfault.pl line 6 during globa
+l destruction.
DESTROYING IO::Handle=IO(0x815c018) at segfault.pl line 6 during globa
+l destruction.
[download]