The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!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, "<STATRT> first test (tolerable error: 0)");

gctest();

cmp_ok(T->count, "<=", 4, "<STATRT> second test (tolerable error: 3)");

gctest();

cmp_ok(T->count, "<=", 4, "<STATRT> third test (tolerable error: 3)");

gctest();