The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More tests => 24;

SKIP: {
    eval "use File::Temp qw{ tempfile tempdir } ";
    skip "File::Temp not installed", 24 if $@;

    my ($fh, $filename) = tempfile(UNLINK => 1);
    diag("using temporary program file '$filename' to test functionality");

    my $contents = <<'EOT';
use App::Rad;
App::Rad->run();

sub command {
    my $c = shift;

    my $ret = 'Called: ' . $c->cmd . ' (' . $c->command . ")\n";

    $c->execute('list_commands');
    $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n";

    $c->register($c->create_command_name(), sub { return "test" });
    $c->register_command('alias', \&anothercommand, 'this is an alias');
    $c->unregister_command('yetanothercommand');
    $c->unregister('andanotherone');

    $c->execute('list_commands');
    $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n";

    $c->execute('alias');
    $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n";

    $c->execute('cmd1');
    $ret .= 'Called: ' . $c->cmd . ' (' . $c->command . ")\n";

    if ( $c->is_command('yetanothercommand') ) {
        $ret .= "error unregistering 'yetanothercommand'";
    }

    return $ret;
}

sub anothercommand { return "this is an alias, over" };

sub andanotherone { }

sub yetanothercommand { }

sub list_commands {
    my $c = shift;

    my $ret .= 'Available: ' . $c->commands . "\n";

    foreach ( sort $c->commands ) {
        $ret .= "$_:";
        $ret .= $c->is_command($_) ? 'ok' : 'not a command';
        $ret .= "\n";
    }
    return $ret;
}

EOT

    print $fh $contents;
    close $fh;
   
    my $ret = `$^X $filename command`;
    my @ret = split m{$/}, $ret;
    is(scalar (@ret), 23);
    is($ret[0], 'Available: 6');
    is($ret[1], 'andanotherone:ok');
    is($ret[2], 'anothercommand:ok');
    is($ret[3], 'command:ok');
    is($ret[4], 'help:ok');
    is($ret[5], 'list_commands:ok');
    is($ret[6], 'yetanothercommand:ok');
    is($ret[7], '');
    is($ret[8], 'Available: 6');
    is($ret[9], 'alias:ok');
    is($ret[10], 'anothercommand:ok');
    is($ret[11], 'cmd1:ok');
    is($ret[12], 'command:ok');
    is($ret[13], 'help:ok');
    is($ret[14], 'list_commands:ok');
    is($ret[15], '');
    is($ret[16], 'this is an alias, over');
    is($ret[17], 'test');
    is($ret[18], 'Called: command (command)');
    is($ret[19], 'Called: list_commands (list_commands)');
    is($ret[20], 'Called: list_commands (list_commands)');
    is($ret[21], 'Called: alias (alias)');
    is($ret[22], 'Called: cmd1 (cmd1)');
}