Seg fault with Moose::Meta::Attribute::Native?

[Ian Sillitoe]

I was just writing a role to organise how I integrate svn:keywords into my
code base and I figured I would take the opportunity to finally get round to
taking a look at Moose::Meta::Attribute::Native.

All looks great, but I stumbled across what seems (to me) to be a fairly
innocuous bit of my code that reliably generates a segmentation fault (in
perl-5.8.8 and perl-5-10.1). It's entirely possible I'm doing something
stupid but even so - I was surprised to see the seg fault and I'm having
difficulty figuring out where the problem lies because the debugger just
hangs before I get any useful output (with high CPU / low memory usage).

It's not an urgent issue as I can work around it (equivalent code in
MX::AttributeHelpers works fine), but I was interested in what might be
happening?

Cheers,

Ian


Abstracted code (dist tarball attached)...

### t/01.bugtest.t

use Test::More tests => 4;

use BugTest;

my $bugtest = BugTest->new();

is( $bugtest->get_svn_author, 'sillitoe' );
is( $bugtest->get_svn_date, '2009-11-09 18:34:01 +0000 (Mon, 09 Nov 2009)'
);
is( $bugtest->get_svn_rev, 9046 );
is( $bugtest->get_svn_id, 'BugTest.pm 9046 2009-11-09 18:34:01Z sillitoe' );

__END__

### lib/BugTest.pm

package BugTest;

use Moose;

our $VERSION = '0.01';

with 'Class::HasSvnKeywords';

sub _build_svn_info {
    return [
        '$Author: sillitoe $',
        '$Date: 2009-11-09 18:34:01 +0000 (Mon, 09 Nov 2009) $',
        '$Rev: 9046 $',
        '$Id: BugTest.pm 9046 2009-11-09 18:34:01Z sillitoe $',
    ]
}

no Moose;
__PACKAGE__->meta->make_immutable;
1;

__END__

### lib/Class/HasSvnKeywords.pm

package Class::HasSvnKeywords;

use Moose::Role;
use MooseX::AttributeHelpers;
use Readonly;

requires '_build_svn_info';

Readonly my @ACCEPTED_SVN_KEYWORDS => qw( Author Date Rev Id Header );

has '_svn_accepted_keywords' => (
    is          => 'ro',
    isa         => 'ArrayRef[Str]',
    lazy_build  => 1,
    builder     => '_build_svn_accepted_keywords',

    # perl -I lib t/01.bugtest.t
    # 1..4
    # ok 1
    # ok 2
    # ok 3
    # ok 4

    metaclass   => 'Collection::Array',
    provides    => {
        elements    => 'get_all_svn_accepted_keywords',
        first       => 'find_svn_accepted_keyword',
    },

    # comment above and uncomment below...

    # perl -I lib t/01.bugtest.t
    # 1..4
    # Segmentation fault

    # traits      => [ 'Array' ],
    # handles     => {
    #     get_all_svn_accepted_keywords   => 'elements',
    #     find_svn_accepted_keyword       => 'first',
    # },

);

sub _build_svn_accepted_keywords { \...@accepted_svn_keywords }

has '_svn_info' => (
    traits      => [ 'Hash' ],
    is          => 'ro',
    isa         => 'HashRef[Str]',
    lazy_build  => 1,
    handles     => {
        get_svn_info    => 'get',
        get_svn_rev     => [ get => 'rev' ],
        get_svn_date    => [ get => 'date' ],
        get_svn_author  => [ get => 'author' ],
        get_svn_id      => [ get => 'id' ],
    },
);

sub _build__svn_info {
    my $self = shift;

    my $lookup_ref = $self->_build_svn_info();

    ref $lookup_ref eq 'ARRAY'
        or confess "sub _build_svn_info { } must return a ARRAY ref (got:
".(ref $lookup_ref).")";

    my %svn_lookup = ();
    my @accepted_keywords = $self->get_all_svn_accepted_keywords;

    foreach my $info ( @$lookup_ref ) {

        # $Rev: 1234 $
        $info =~ m{ ^       # start
                    \$      # '$'
                    (\w+)   # SVN keyword
                    :+      # one or more ':'
                    \s*     # optional spaces before value
                    (.*?)   # SVN value (if any)
                    \s*     # optional spaces after value
                    \$      # '$'
                  }xms
            or confess "unexpected format of SVN keywords '$info' (expected
'\$Rev: (.*?) $')";

        my ($name, $value) = ($1, $2);

        confess "the keyword '$name' is not in the list of accepted svn
keywords (".join( ", ", @accepted_keywords).")"
            unless $self->find_svn_accepted_keyword( $name );

        warn( "Could not find a value for svn:keyword $name in " . (blessed
$self) . "\n".
              " - either the svn:keyword property has not been set or the
file is waiting for first svn commit" )
            unless $value;

        $svn_lookup{ lc( $name ) } = $value || 'N/A';
    }

    return \%svn_lookup;
};

1;

__END__


I get the same results with two different versions of perl I have to hand:

perl-5.8.8
  Platform:
    osname=linux, osvers=2.6.9-42.0.3.elsmp, archname=x86_64-linux
    uname='linux fletcher 2.6.9-42.0.3.elsmp #1 smp fri oct 6 06:28:26 cdt
2006 x86_64 x86_64 x86_64 gnulinux '

perl-5.10.1
  Platform:
    osname=linux, osvers=2.6.18-128.7.1.el5xen, archname=x86_64-linux
    uname='linux caffdubya 2.6.18-128.7.1.el5xen #1 smp mon aug 24 09:14:33
edt 2009 x86_64 x86_64 x86_64 gnulinux '

If I run under the debugger...

sillitoe % BugTest/ : perl -d -I lib t/01.bugtest.t

Loading DB routines from perl5db.pl version 1.28
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

1..4
main::(t/01.bugtest.t:5):       my $bugtest = BugTest->new();

DB<1> n
main::(t/01.bugtest.t:7):       is( $bugtest->get_svn_author, 'sillitoe' );

DB<1>
[... hangs with high CPU usage but low memory ... ]

BugTest-0.01.tar.gz
Description: GNU Zip compressed data