perlのハッシュでユニットテストから期待される出力を受け取っていません

Question

私のテストを他のテストと統合しました。エラーハッシュがあり、正しい/期待される出力が出力されません。私のnew（）メソッドは今でもìs_errorのチェックを持っていますので、私の新しいメソッドの出力と関係するかもしれません。 new（）メソッドは、引数の有無にかかわらずエラーハッシュを受け入れるか、または引数なしのエラー文字列を受け取ります。これは、エラー・ハッシュまたは文字列自体が削除され、交換される最初の引数（としてcodeを受け入れる。（まあそれは私が達成しようとしているものです。

だから私は今、あなたのコードを紹介します。

Error.pm

package ASC::Builder::Error; 

    use strict; 
    use warnings; 
    use parent 'Exporter'; 
    our @EXPORT_OK = qw/new/; 

    # Method for creating error message 
    sub new { 
     my ($class, %args) = @_; 
     # Takes code in as an argument and then removes it so the error hash it self can be assigned to it 
     my $self = delete $args{code}; 
     #my $error = %args{0}; 
     if (is_error($self)) { 
      return $self; 
     } 
     # 1st argument will be error hash. Any other arguments will be context params & inserted into 
     # context field of the error hash 
     my @args = keys %args; 
     if (ref $self eq 'HASH' && (@args > 1)) { 
      foreach my $key (@{ $self->{context} }) { 
       # And take the ones we need 
       $self->{args}->{$key} = $args{$key}; 
     } 
     my @template_args = map { $self->{args}->{$_} } @{ $self->{context} }; 

     # Map/Insert arguments into context hash and insert into string template 
     $self->{message} = sprintf ($self->{template}, @template_args); 
     return bless $self, $class; 
     } 
     # Supporting the old error messaage (string & parameters) 
     else { 
      return bless { message => %args } , $class; 
     } 
    } 

    # Accessor for category 
    sub category { 
     return shift->{category}; 
    } 

    # Accessor for message 
    sub template { 
     return shift->{template}; 
    } 
    # Accessor for context 
    sub context { 
     return shift->{context}; 
    } 
# Accessor for template option 
    sub tt { 
     return shift->{tt}{template}; 
    } 
    # Accessor for fatal 
    sub is_fatal { 
     return shift->{fatal}; 
    } 
    # Setter for is_fatal 
    sub set_is_fatal { 
     my ($self, $fatal) = @_; 
     $self->{fatal} = $fatal; 
    } 

    # Accessor for wiki_page 
    sub wiki_page { 
     return shift->{wiki_page}; 
    } 
    # Accessor for args. args are a hash ref of context parameters that are 
    # passed in as a list at construction 
    sub args { 
     return shift->{args}; 
    } 
    # Accessor for error message which is processed inside the new() method. 
    # Will return error message with context parameters inserted. 
    sub message { 
     return shift->{message}; 

    } 
    # Stringifies the error to a log message (for SB dashboard), including the 
    # category, message, and wiki_page. 
    sub stringify { 
     my ($self) = @_; 
     return sprintf ("%s: %s\nMore info: %s",$self->{category}, $self->{message}, $self->{wiki_page}); 
    } 

    # Accessor for old error message type 
    sub details { 
     my $self = shift; 
     return $self->{details} || $self->{message}; 
    } 
    sub code { 
     return shift->{code}; 
    } 
# Used to deserializ from build json. 
    sub recreate_from_hash { 
     my($class, $hash) = @_; 
     return bless $hash, $class; 
    } 

    # Use to check if something is out error. 
    sub is_error { 
     if (scalar(@_) > 1) { # Called as $class->is_error 
      shift; # Get rid of class 
     } 
     return UNIVERSAL::isa(shift, 'ASC::Builder::Error'); 
    } 
    1; 

Type.pm

package ASC::Builder::Error::Type; 
    use strict; 
    use warnings; 
    use parent 'Exporter'; 

    # Export the list of errors 
    our @EXPORT_OK = qw/ 
    UNABLE_TO_PING_SWITCH_ERROR 
    code 
    /; 
    # List of error message 
use constant code => { 
    use constant { 
     CABLING_CHECK_TOR_INCORRECT_CABLING_ERROR => { 
      category => 'Cabling Error', 
      template => "ToR cabling is not correct at T1.The uplinks must be cabled to exactly one t1 device group", 
      tt => { template => 'disabled'}, 
      fatal => 1, 
      wiki_page =>'http://w.error-fix.com/index.php/Builder/ErrorCodes/CABLING_CHECK_TOR_CABLING_INCORRECT_ERROR', 
     }, 
     UPDATE_IMAGE_ERROR => { 
      category => 'Imaging Error', 
      template => "Cannot determine switch model", 
      tt => { template => 'disabled'}, 
      fatal => 1, 
      wiki_page =>'http://w.error-fx.com/index.php/Builder/ErrorCodes/UPDATE_IMAGE_ERROR', 
     }, 
     UNABLE_TO_PING_SWITCH_ERROR => { 
      category => 'Connection Error', 
      template => "Could not ping switch %s in %s seconds.", 
      context => [ qw(switch_ip timeout) ], 
      tt => {template => 'disabled'}, 
      fatal => 1, 
      wiki_page => 'http://w.error-fix.com/index.php/Builder/ErrorCodes/UNABLE_TO_PING_SWITCH_ERROR', 
     }, 
     UNKNOWN_CLIENT_CERT_ID_ERROR => { 
      category => 'Services Error', 
      template => "Unknown client certificate id: %s", 
      context => qw(cert_id), 
      tt => { template => 'disabled'}, 
      fatal => 1, 
      wiki_page =>'http://w.error-fix.com/index.php/Builder/ErrorCodes/', 
     }, 
    # Add errors to this library 
    }; 
    1; 

Error.t

use lib ('./t/lib'); 
    use strict; 
    no strict 'refs'; 
    use warnings; 

    use ASC::Builder::Error; 
    use ASC::Builder::Error::Type; 

    use Test::More; 
    use Test::Exception; 
    use LWP::Simple 'head'; # Used to test if wiki link is giving a response 

    test_functionality_of_old_error(); 
    test_functionality_of_new_error(); 
    test_correctness_of_type_pm(); 

    sub test_functionality_of_old_error { 
    # Example runtime parameters 
    my $switch_ip = '192.192.0.0'; 
    my $timeout = '30'; 

     # Correct case 
     { 
      my $error = ASC::Builder::Error->new(sprintf 'Could not ping switch %s in %s seconds', $switch_ip, $timeout); 
      ok(ASC::Builder::Error->is_error($error), 'Should detect error'); 
      isa_ok ($error, 'ASC::Builder::Error'); 
      is($error->message, 'Could not ping switch 192.192.0.0 in 30 seconds'); 
     }; 
    }; 



    sub test_functionality_of_new_error { 
     my $example_error = { 
      category => 'Connection Error', 
      template => 'Could not ping switch %s in %s seconds.', 
      context => [ qw(switch_ip timeout) ], 
      tt => {template => 'disabled'}, 
      fatal => 1, 
      wiki_page => 'http://w.error-fix.com/index.php/Builder/ErrorCodes/UNABLE_TO_PING_SWITCH_ERROR', 
     }; 

     # Correct case 
     { 
      my $error = ASC::Builder::Error->new(code => $example_error, timeout => 30, switch_ip => '192.192.0.0'); 

      isa_ok ($error, 'ASC::Builder::Error'); 
can_ok ($error, 'category'); 
      is ($error->category(), 'Connection Error', 'Return the correct category'); 

      can_ok ($error, 'template'); 
      is ($error->template(), 'Could not ping switch %s in %s seconds.', 'Return the correct category'); 

      can_ok ($error, 'tt'); 
      is ($error->tt(), 'disabled', 'Return the correct tt template'); 

      can_ok ($error, 'context'); 
      is_deeply($error->context(), ['switch_ip', 'timeout'], 'Return the correct context params'); 

      can_ok ($error, 'is_fatal'); 
      ok($error->is_fatal(), 'Return the correct value'); 

      can_ok ($error, 'message'); 
      is ($error->message(), 'Could not ping switch 192.192.0.0 in 30 seconds.', 'Return the correct message'); 

      can_ok ($error, 'stringify'); 
      is ($error->stringify(), "Connection Error: Could not ping switch 192.192.0.0 in 30 seconds.\nMore info: http://w.error-fix.com/index.php/Builder/ErrorCodes/      UNABLE_TO_PING_SWITCH_ERROR", 'stringify creates the correct message'); 

    }; 

     # Too many arguments (this is okay) 
     lives_ok(sub { ASC::Builder::Error->new(code => $example_error, timeout => 1, switch_ip => 2, extra => 3) }, 'Creating with too many arguments lives. (allows for additional   context string to be added in the code)'); 
     }; 

     sub test_correctness_of_type_pm { 

    # These test cases contain all the errors from Type.pm 
     my @test_cases = (
      { 
       name => 'UNABLE_TO_PING_SWITCH_ERROR', 
       args => { 
        switch_ip => '192.192.0.0', 
        timeout => 30, 
       }, 
       message => 'Could not ping switch 192.192.0.0 in 30 seconds.', 
      }, 
    ); 
    foreach my $t (@test_cases) { 
     subtest $t->{name} => sub { 
      no strict 'refs'; # Because we need to use variable to get to a constant 
      ASC::Builder::Error::Type->import($t->{name}); 

      # Create the Error object from the test data 
      # Will also fail if the name was not exported by Type.pm 
      my $error; 
      lives_ok(sub { $error = ASC::Builder::Error->new(code => &{ $t->{name} },%{ $t->{args} }) }, 'Error can be created'); 

      # See if it has the right values 
      is ($error->message, $t->{message}, 'Error message is correct'); 

      # Using LWP::Simple to check if the wiki page link is not broken 
      # ok head($error->wiki_page); #CANT'T GET THIS TEST TO WORK 


      } 
     } 
    }; 
    done_testing; 

ここに追加しようとしている単体テストです。彼らはすべてが最後のを除いて渡すように見える：

​​

私はそれが何かはnew内部で呼び出されるis_errorメソッドの戻り値で行うようになったと思います。任意の助けいただければ幸い:)

#Test Output: 

# Failed test 'Should return the provided argument' 
# at t/01_general_errors.t line 33. 
#   got: 'ASC::Builder::Error=HASH(0x7fbe4bbd5220)' 
#  expected: 'I'll be back' 

Answer 1

あなたis_errorチェックはコンストラクタ

my $self = delete $args{code}; 
    if (is_error($self)) { 
     return $self; 
    } 

に提供code引数にありますが、あなたは、あなたのテストで

is(ASC::Builder::Error->new(ASC::Builder::Error->new("I'll be back"))->message(),...); 

を code引数を指定しません

最後の行はおそらく

であるはずです

is(ASC::Builder::Error->new(
     code => ASC::Builder::Error->new("I'll be back")), ...); 

あなたは奇数の要素でハッシュを初期化するという警告を受けているはずです。