#!perl
use strict;
use warnings;
use Test::More;
plan( tests => 22 );
use YAML;
use Clone qw( clone );
use Decision::Depends;
use Decision::Depends::Var;
require 't/common.pl';
require 't/depends.pl';
our $verbose = 0;
our $error = 0;
my $err;
our ( $deplist, $targets, $deps );
#---------------------------------------------------
# check different means of specifying variable name
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-depend => -var => ( -foo => 'data/dep1' ) );
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] }}
), 'variable dependency, variable name as attribute' )
or diag( $err );
# check different means of specifying variable name
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-depend => '-var=foo' => 'data/dep1' );
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] }}
), 'variable dependency, variable name as attr value' )
or diag( $err );
# check different means of specifying variable name
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-depend => -var => { foo => 'data/dep1' } );
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] }}
), 'variable dependency, variable name as attr value via hashref' )
or diag( $err );
#---------------------------------------------------
# variable dependency, no var. this is ok.
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-depend => -var => ( -foo => 'data/dep1' ) );
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] }}
), 'variable dependency, no variable' )
or diag( $err );
#---------------------------------------------------
# variable dependency, var with same value.
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-depend => -var => ( -foo => 'val' ),
sub { $Decision::Depends::self->{State}->setVar( 'data/targ1', foo => 'val' ) }
);
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { } ),
'variable dependency, unchanged value' )
or diag( $err );
#---------------------------------------------------
# variable dependency, var with different value.
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-depend => -var => ( -foo => 'val' ),
sub { $Decision::Depends::self->{State}->setVar( 'data/targ1', foo => 'val2' ) }
);
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] } }
),
'variable dependency, different value' )
or diag( $err );
#---------------------------------------------------
# variable dependency, var with same value.
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( -target => 'data/targ1',
-force => -depend => -var => ( -foo => 'val' ),
sub { $Decision::Depends::self->{State}->setVar( 'data/targ1', foo => 'val' ) }
);
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] } }
),
'local force variable dependency' )
or diag( $err );
#---------------------------------------------------
# variable dependency, var with same value.
eval {
cleanup();
touch( 'data/targ1' );
( $deplist, $targets, $deps ) =
submit( { Force => 1 },
-target => 'data/targ1',
-depend => -var => ( -foo => 'val' ),
sub { $Decision::Depends::self->{State}->setVar( 'data/targ1', foo => 'val' ) }
);
};
$err = $@;
ok ( !$@ &&
eq_hash( $deps, { 'data/targ1' => {
var => [ 'foo' ],
time => [],
sig => [] } }
),
'global force variable dependency' )
or diag( $err );
#---------------------------------------------------
# variable dependency, guess numeric variable
eval {
cleanup();
Decision::Depends::Configure( { Verbose => $verbose, File => 'data/deps' } );
my $val = '0.1470';
$error = 1;
if_dep { -slink => 'data/targ1', -var => -val => $val }
action {
$error = 0;
};
};
$err = $@;
ok ( ! $error && !$@, 'setup guessed numerical variable deps' )
or diag( $err );
eval {
my $val = 0.147;
if_dep { -slink => 'data/targ1', -var => -val => $val }
action {
die( "shouldn't get here!\n" );
};
};
$err = $@;
ok ( !$@, 'guessed numerical values' )
or diag( $err );
#---------------------------------------------------
# variable dependency, force numeric variable
eval {
cleanup();
Decision::Depends::Configure( { Verbose => $verbose, File => 'data/deps1' } );
my $val = '0.1470';
$error = 1;
if_dep { -slink => 'data/targ1', -var => -numcmp => -val => $val }
action {
$error = 0;
};
};
$err = $@;
ok ( ! $error && !$@, 'setup forced numerical variable deps' )
or diag( $err );
eval {
my $val = 0.147;
if_dep { -slink => 'data/targ1', -var => -numcmp => -val => $val }
action {
die( "shouldn't get here!\n" );
};
};
$err = $@;
ok ( !$@, 'forced numerical values' )
or diag( $err );
eval {
my $val = 0.147;
$error = 1;
if_dep { -slink => 'data/targ1', -var => -strcmp => -val => $val }
action {
$error = 0;
};
};
$err = $@;
ok ( !$@, 'forced string compare of num values' )
or diag( $err );
#---------------------------------------------------
# variable dependency, force string compare
eval {
cleanup();
Decision::Depends::Configure( { Verbose => $verbose, File => 'data/deps1' } );
my $val = 'snake';
$error = 1;
if_dep { -slink => 'data/targ1', -var => -val => $val }
action {
$error = 0;
};
};
$err = $@;
ok ( ! $error && !$@, 'setup forced string variable deps' )
or diag( $err );
eval {
my $val = 'snake';
if_dep { -slink => 'data/targ1', -var => -strcmp => -val => $val }
action {
die( "shouldn't get here!\n" );
};
};
$err = $@;
ok ( !$@, 'forced numerical values' )
or diag( $err );
eval {
my $val = 0.147;
$error = 1;
if_dep { -slink => 'data/targ1', -var => -strcmp => -val => $val }
action {
$error = 0;
};
};
$err = $@;
ok ( !$error && !$@, 'forced string compare of num values' )
or diag( $err );
#---------------------------------------------------
{
cleanup();
Decision::Depends::Configure( { Verbose => $verbose, File => 'data/deps1' } );
my $scalar = 'snake';
my @array = ( 'snake' );
my %hash = ( reptile => 'snake' );
# make sure everything is fresh
sub var { return { scalar => $scalar,
array => \\@array,
hash => \\%hash }
};
# variable dependency, HASH, ARRAY values
# first make sure the parsing works
eval {
$error = 1;
if_dep { -slink => 'data/targ1',
-var => var();
}
action {
$error = 0;
};
};
$err = $@;
ok ( ! $error && !$@, 'hash, array parse' )
or diag( $err );
# Test::More::eq_array (0.80) does damage to the passed structures
# such that it causes subsequent clones to fail. So, create
# a copy of the expected results so that the damage is isolated.
my $cmp = clone({
scalar => $scalar,
array => \@array,
hash => \%hash });
# make sure output is what is expected
ok( eq_hash( YAML::LoadFile( 'data/deps1' )->{Var}{'data/targ1'},
$cmp ),
"hash, array values" );
# same values as before
eval {
$error = 0;
if_dep { -slink => 'data/targ1',
-var => var();
}
action {
$error = 1;
};
};
$err = $@;
ok ( ! $error && !$err, 'dependency met' )
or diag( $err );
# now change something and see what happens.
for my $tst (
[ scalar => sub { $scalar = 'bird' } ],
[ array => sub { @array = ( 'bird' ) } ],
[ hash => sub { %hash = ( avian => 'bird' ) } ]
)
{
my ( $label, $sub ) = @$tst;
eval {
$sub->();
$error = 1;
if_dep { -slink => 'data/targ1',
-var => var() }
action {
$error = 0;
};
};
$err = $@;
ok ( ! $error && !$@, "change $label" )
or diag( $err );
}
}
#---------------------------------------------------
cleanup();