App-Framework-Lite
view release on metacpan
or search on metacpan
t/01-Man.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.234' ;
my $DEBUG =1;
my $VERBOSE =1;
my $stdout = "" ;
my $stderr = "" ;
print "debug $DEBUG\n" ;
diag( "Testing usage" );
my @man = (
'Must specify input file "source"' ,
'-help|h Print help' ,
'-man Full documentation' ,
'-name|n <arg> Test name' ,
|
t/01-Man.t
view on Meta::CPAN
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | '-man' ,
) ;
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
print "I was hoping for more!\n" ;
} ;
if (! $stdout )
{
diag( "Sorry, can't redirect stdout: $@" ) ;
plan skip_all => 'Unable to redirect stdout (I need to redirect to check the man pages)' ;
exit 0 ;
}
else
|
t/01-Man.t
view on Meta::CPAN
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 |
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
@ARGV = () ;
App::Framework::Lite->new( 'exit_type' => 'die' )->go() ;
} ;
print "App: $stdout\n\n" ;
foreach my $test ( @man )
{
|
t/01-Mandev.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.234' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing usage" );
my @sections = qw/NAME SYNOPSIS OPTIONS DESCRIPTION/ ;
my @mandev = (
'-pod Output full pod' ,
'-dbg-data Debug option: Show __DATA__' ,
'-dbg-data-array Debug option: Show all __DATA__ items' ,
'-int=i An integer' ,
'-float=f An float' ,
|
t/01-Mandev.t
view on Meta::CPAN
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 |
$stdout = "" ;
$stderr = "" ;
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
@ARGV = ( '-man-dev' ) ;
App::Framework::Lite->new( 'exit_type' => 'die' )->go() ;
pop @ARGV ;
} ;
print "App -man-dev: $stdout\n\n" ;
if (! $stdout )
|
t/02-Options-1.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.234' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing options" );
my %expected_options = (
'name=s' => 'a name' ,
'default=s' => 'a default' ,
'default2=s' => 'b default' ,
'default3=s' => 'c default' ,
'log=s' => 'new setting' ,
|
t/02-Options-2.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.234' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing options" );
my %expected_options = (
'name=s' => 'a default' ,
'default=s' => 'a default' ,
'default2=s' => 'a default a default' ,
'default3=s' => 'a default a default another default' ,
'log=s' => 'another default' ,
|
t/02-Options-3.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.234' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing options expanded variables" );
my %expected_options = (
'test_name=s' => 'this is different' ,
'default=s' => 'this is different' ,
'default2=s' => 'my def' ,
'default3=s' => 'my def another default' ,
'log=s' => 'another default' ,
|
t/02-Options-4.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.234' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing options and args expanded variables" );
my %expected_options = (
'test_name=s' => 'im the series name' ,
'default=s' => 'im the series name' ,
'default2=s' => 'im the series name im the series name' ,
'default3=s' => 'im the series name im the series name another default' ,
'log=s' => 'another default' ,
|
t/04-Args.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '2.01' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing args" );
my $input_checks = 3 ;
my @args = (
[ 'src1' , 't/args/file.txt' ],
[ 'src2' , 't/args/dir' ],
[ 'src3' , 't/args/exists.txt' ],
[ 'out1' , 't/args/outfile' ],
[ 'out2' , 't/args/outdir' ],
|
t/04-Args.t
view on Meta::CPAN
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | push @ARGV , $val ;
++ $arg ;
}
push @ARGV , @array ;
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
$app ->go() ;
};
print "reply: $stdout" ;
like( $stdout , qr/Error: Must specify/ i, "Input checking" ) ;
}
foreach my $arg_aref ( @args )
{
my $val = $arg_aref ->[1] ;
push @ARGV , $val ;
}
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
$app ->go() ;
};
print "reply: $stdout" ;
like( $stdout , qr/Error: Must specify/ i, "Input array checking" ) ;
@ARGV = () ;
foreach my $arg_aref ( @args )
{
push @ARGV , $arg_aref ->[1] ;
|
t/04-ArgsArray.t
view on Meta::CPAN
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '2.01' ;
my $DEBUG =0;
my $VERBOSE =0;
my $SKIP =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing args (array)" );
my @array = (
't/args/file.txt' ,
't/args/exists.txt' ,
't/args/array.txt' ,
) ;
plan tests => 1 + (1 + scalar ( @array ) );
|
t/04-ArgsArray.t
view on Meta::CPAN
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | }
},
) ;
@ARGV = () ;
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
$SKIP =1;
$app ->go() ;
};
print "reply: $stdout" ;
like( $stdout , qr/Error: Must specify/ i, "Input array checking" ) ;
foreach my $val ( @array )
{
push @ARGV , $val ;
|
t/04-ArgsArray2.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | our $VERSION = '2.00' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing args (array no-check)" );
plan tests => 1 ;
my $app = App::Framework::Lite->new( 'exit_type' => 'die' ) ;
@ARGV = () ;
eval {
local *STDOUT ;
local *STDERR ;
open (STDOUT, '>' , \ $stdout ) or die "Can't open STDOUT: $!" ;
open (STDERR, '>' , \ $stderr ) or die "Can't open STDERR: $!" ;
$app ->go() ;
};
print "reply: $stdout\n" ;
unlike( $stdout , qr/Error: Must specify/ i, "Input array checking" ) ;
$@ =~ s/Died.*//m if $@ ;
print "$@" if $@ ;
|
t/04-ArgsDefault.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '2.01' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing args (open handles with defaults)" );
my @args = (
|
t/04-ArgsOpen.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '2.01' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing args (open handles)" );
my @args = (
|
t/04-ArgsWild.t
view on Meta::CPAN
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | our $VERSION = '1.00' ;
my $DEBUG =0;
my $VERBOSE =0;
my $SKIP =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing args (array)" );
my @array = (
't/args/array.txt' ,
't/args/exists.txt' ,
't/args/file.txt' ,
't/args/file.txt' ,
|
t/05-Data.t
view on Meta::CPAN
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | our $VERSION = '2.00' ;
my $DEBUG =0;
my $VERBOSE =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing data" );
my $NAMED1 =<< 'NAMED1' ;
|
t/08-embed.t
view on Meta::CPAN
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | #!/usr/bin/perl
my $DEBUG =0;
my $stdout = "" ;
my $stderr = "" ;
diag( "Testing module embed" );
my $embedded_script = "./t/embed.pl" ;
unlink $embedded_script ;
my @run_args = (
[ 'run' , '' ],
[ 'help' , '-help' ],
[ 'man' , '-man' ],
|