1use utf8; 2use strict; 3use warnings; 4use lib 't/lib/'; 5use Test::More 0.88; 6use SubtestCompat; 7use TestBridge; 8use TestUtils; 9 10use CPAN::Meta::YAML; 11use File::Basename qw/basename/; 12use File::Spec::Functions 'catfile'; 13use File::Temp 0.19; # newdir 14 15#--------------------------------------------------------------------------# 16# Error conditions 17#--------------------------------------------------------------------------# 18 19subtest 'no filename for write()' => sub { 20 my $obj = CPAN::Meta::YAML->new(); 21 eval { $obj->write(); }; 22 error_like( qr/You did not specify a file name/, 23 "No filename provided to write()" 24 ); 25}; 26 27#--------------------------------------------------------------------------# 28# Test that write uses correct encoding and can round-trip 29#--------------------------------------------------------------------------# 30 31my @cases = ( 32 { label => "ascii", name => "Mengue" }, 33 { label => "latin1", name => "Mengué" }, 34 { label => "wide", name => "あ" }, 35); 36 37my @warnings; 38local $SIG{__WARN__} = sub { push @warnings, $_[0] }; 39 40# CPAN::Meta::YAML doesn't preserve order in the file, so we can't actually check 41# file equivalence. We have to see if we can round-trip a data structure 42# from Perl to YAML and back. 43for my $c ( @cases ) { 44 subtest "write $c->{label} characters" => sub { 45 my $data; 46 @warnings = (); 47 48 # get a tempfile name to write to 49 my $tempdir = File::Temp->newdir("YTXXXXXX", TMPDIR => 1 ); 50 my $short_tempfile = 'output'; 51 my $tempfile = catfile($tempdir, $short_tempfile); 52 53 # CPAN::Meta::YAML->write 54 ok( CPAN::Meta::YAML->new($c)->write($tempfile), 55 "case $c->{label}: write $short_tempfile" ) 56 or diag "ERROR: " . CPAN::Meta::YAML->errstr; 57 58 # CPAN::Meta::YAML->read 59 ok( $data = eval { CPAN::Meta::YAML->read( $tempfile ) }, 60 "case $c->{label}: read $short_tempfile" ) 61 or diag "ERROR: " . CPAN::Meta::YAML->errstr; 62 is( $@, '', "no error caught" ); 63 SKIP : { 64 skip "no data read", 1 unless $data; 65 cmp_deeply( $data, [ $c ], 66 "case $c->{label}: Perl -> File -> Perl roundtrip" ); 67 } 68 69 # CPAN::Meta::YAML->read_string on UTF-8 decoded data 70 ok( $data = eval { CPAN::Meta::YAML->read_string( slurp($tempfile, ":utf8") ) }, 71 "case $c->{label}: read_string on UTF-8 decoded $short_tempfile" ); 72 is( $@, '', "no error caught" ); 73 SKIP : { 74 skip "no data read", 1 unless $data; 75 cmp_deeply( $data, [ $c ], 76 "case $c->{label}: Perl -> File -> Decoded -> Perl roundtrip" ); 77 } 78 79 is( scalar @warnings, 0, "case $c->{label}: no warnings caught" ) 80 or diag @warnings; 81 } 82} 83 84done_testing; 85