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