#!perl use warnings; use strict; use Test::More tests => 89; sub DEBUG(){ 0 } END{ pass "test end" } BEGIN{ use_ok('Ruby', ':DEFAULT', 'lambda(&)', 'rb_c', 'rb_m') } use Ruby -class => qw(GC Hash Array); #use constant GC => rb_m GC; #use constant Hash => rb_c Hash; #use constant Array => rb_c Array; { package T; my $count = 0; sub new{ $count++;bless do{ my $o=$count; \$o } }; sub DESTROY{ Carp::carp "#DESTROY $count" if main::DEBUG; $count--; } sub inspect{ "T:${$_[0]}" }; sub id{ ${$_[0]} } sub count{ $count } } sub Dump{ require Devel::Peek; &Devel::Peek::Dump; } use Ruby -eval => <<'.'; def perl_ary_push(ary, val) a = Perl::Array.new; a.push(val, Perl::String("foo"), "bar"); ary.push(a); end def empty() end . sub gctest{ my $o = Hash->new(); for(1 .. 100){ GC->start; my $a = Array->new(); my $t = T->new; my $l = lambda{ $t }; } GC->start; cmp_ok(T->count, '<=', 4, 'new & gc'); my $lambda; my @ary; for(1 .. 1000){ my $h = Hash->new(); my $a = Array->new(); my $i = $_; $lambda = lambda { is $i, 1000, "lambda->()" }; perl_ary_push(\@ary, T->new); } GC->start; for(my $i = 0; $i < 5; $i++){ is ref($ary[$i]), 'ARRAY', "push in ruby"; isa_ok $ary[$i][0], 'T'; is $ary[$i][1], "foo", "scalar is alive"; # new scalar is $ary[$i][2], "bar", "str is alive"; # ruby str } cmp_ok(T->count - 1000, "<=", 2, "T->count is 1000 (or 1001)") ; @ary = (); GC->start; $lambda->(); # lambda { is $i, 1000, "lambda->()" }; GC->start; $lambda->(); cmp_ok(T->count, '<=', 2, "start, T->count is zero (or 1)"); { my @a; for(1 .. 1000){ my $h = Hash->new; push @a, $h; $h->store('foo', T->new()); } cmp_ok(T->count - 1000, '<=', 2, "T's object is alive (befor GC)"); GC->start; cmp_ok(T->count - 1000, '<=', 2, "T's object is alive (after GC)"); } GC->start; ok($o->kind_of('Hash'), "alive object"); } cmp_ok(T->count, "<=", 0, " first test (tolerable error: 0)"); gctest(); cmp_ok(T->count, "<=", 4, " second test (tolerable error: 3)"); gctest(); cmp_ok(T->count, "<=", 4, " third test (tolerable error: 3)"); gctest();