use v6; use Test; plan 3; my $destroy_test = 'use v6; class Foo { submethod DESTROY { say "Foo goes away" } } class Parent { submethod DESTROY { say "Parent goes away" } } class Child is Parent { submethod DESTROY { say "Child goes away" } } my $foo = Foo.new(); my $parent = Parent.new(); my $child = Child.new();'; my $out = open('destroy_test.pl', :w); unless $out { diag( "Could not write destroy_test.pl" ); exit; } $out.say( $destroy_test ); $out.close; my ($pugs,$redir) = ($*EXECUTABLE_NAME, ">"); if $*OS eq any <MSWin32 mingw msys cygwin> { $pugs = 'pugs.exe'; $redir = '>'; }; sub nonce () { return (".{$*PID}." ~ (1..1000).pick) } sub run_pugs ($c) { my $tempfile = "temp-ex-output" ~ nonce; my $command = "$pugs $c $redir $tempfile"; diag $command; run $command; my $res = slurp $tempfile; unlink $tempfile; return $res; } my $output = run_pugs("destroy_test.pl"); like( $output, rx:P5/Foo goes away/, 'global destruction should collect objects...' ); like( $output, rx:P5/Parent goes away/, '... of all types' ); like( $output, rx:P5/Child goes away\s*Parent goes away/, '... and calling all destructors' ); END { if ! %*ENV<TEST_DEBUG_FILES> { unlink 'destroy_test.pl'; } }