root/t/oo/global_destruction.t

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';
    }
}