#!perl -T use warnings; use strict; use Test::More tests => 3; use lib qw( t t/lib ./lib ); use MEmployee; BEGIN { inherit MEmployee } is( check_person_export_values(), 'OK', 'MPerson:: exported values'); is( check_worker_export_values(), 'OK', 'MWorker:: exported values'); is( check_employee_export_values(), 'OK', 'MEmployee:: exported values'); exit; ###################################################################### sub check_person_export_values { eval { _check_values( $MPerson::personfield_exp_ok => 'personfield_ok', $MPerson::personfield_exp => 'personfield', $MPerson::COMMON_NAME => 'COMMON_NAME', $MPerson::USERNAME_mk_st => 'USERNAME', \@MPerson::USERNAME_mk_st => ['USERNAME', 'USERNAME'], ); }; if ($@) { chomp $@; return $@ } return 'OK'; } sub check_worker_export_values { eval { no warnings 'once'; # do not complain for "used only once: possible typo" _check_values( $MWorker::personfield_exp_ok => undef, $MWorker::personfield_exp => 'personfield', $MWorker::COMMON_NAME => 'COMMON_NAME', \@MWorker::COMMON_NAME => ['COMMON_NAME', 'list'], $MWorker::USERNAME_mk_st => 'USERNAME', \@MWorker::USERNAME_mk_st => ['USERNAME', 'WORKERNAME'], ); }; if ($@) { chomp $@; return $@ } return 'OK'; } sub check_employee_export_values { eval { _check_values( $MEmployee::SALARY => 'salary', $MEmployee::COMMON_NAME => 'EMPLOYEE_NAME', $MEmployee::DUMMY => 'dummy', $MEmployee::DUMMY2 => 'dummy2_employee', $MEmployee::USERNAME_mk_st => 'USERNAME', # inherited \@MEmployee::COMMON_NAME => ['COMMON_NAME', 'list'], \@MEmployee::USERNAME_mk_st => ['USERNAME', 'WORKERNAME'], #$MEmployee::personfield_exp_ok => 'personfield', # (false) not inherited #$MEmployee::personfield_exp_ok => 'personfield', ); }; if ($@) { chomp $@; return $@ } return 'OK'; } sub _check_values { #my ($check_list) = @_; while (@_) { my ($key, $check) = (shift, shift); if (ref $key eq 'ARRAY') { _check_list_value($key, $check); } elsif (not ref $key) { _check_scalar_value($key, $check); } else { die "Don't know how to compare $key and $check\n"; } } return 'OK'; } sub _check_scalar_value { my ($value1, $value2) = @_; return if (not defined $value1 and not defined $value2); return if $value1 eq $value2; die "'$value1' is not equal to $value2\n"; } sub _check_list_value { my ($list1, $list2) = @_; my $i = 0; while ($list1->[$i] or $list2->[$i]) { next if $list1->[$i] eq $list2->[$i++]; die "List [@$list1] is not equal to [@$list2]\n"; } }