テストエラーは::ループによってスロー警告する

Question

I持ってデータベースを作成し、次のサブルーチン：

sub create_db { 
    my $self = shift; 
    my $name = shift; 
    $self->dbh->do("create database $name") 
} 

このサブルーチンは、ループ内で複数のデータベースを生成し、この1によって呼び出されます。

sub add_all_databases { 
    my $self = shift; 

    foreach my $year (@{$self->years}) { 
    my $name = DB_NAME_PREFIX . $year; 
    $self->create_db($name); 
    } 
} 

データベースがすでに存在する場合、Perlは警告を生成します。私はトンを検査するためのテストを作成したい

DBD::mysql::db do failed: Can't create database 'db_2014'; database exists 

をデータベースがすでに存在する場合、警告がスローされます。私はこのテストでそれを試みました：

use Test::Warn 

warnings_like {$i->add_all_databases} qr{do failed}, 'throws error if database exists'; 

しかし、それは動作していないようです。

not ok 17 - throws error if database exists 
# Failed test 'throws error if database exists' 
# at ./importer.t line 69. 
# found warning: DBD::mysql::db do failed: Can't create database 'db_2000'; database exists at /home/steve/perl/perl-lib/DB.pm line 46, <DATA> line 1. 
# found warning: DBD::mysql::db do failed: Can't create database 'db_2001'; database exists at /home/steve/perl/perl-lib/DB.pm line 46, <DATA> line 1. 
# found warning: DBD::mysql::db do failed: Can't create database 'db_2002'; database exists at /home/steve/perl/perl-lib/DB.pm line 46, <DATA> line 1. 
# expected to find warning: (?^:do failed) 

私はテストスクリプトから次のように出力されます。どのテストに合格するのですか？

Answer 1

警告があるようwarnings_likeに2番目の引数が正確に同じ数の要素を含む配列への参照であるべきである。余談として

warnings_like { warn $_ for 1..3 } [qr/1/, qr/\d/, qr/[345]/]; 

は、異なる数値サフィックスを持つ複数のデータベースを作成する主要なコードのにおいです。一般的に、その年の列を持つ単一のデータベースを持つ方がよいでしょう。