Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
data	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
tml-local	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
tml-spec	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
tml-world	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
01_api.t	1.52 KB	-r--r--r--	2014-12-27 11:48
01_compile.t	363 B	-r--r--r--	2014-12-27 11:48
10_read.t	3.35 KB	-r--r--r--	2014-12-27 11:48
11_read_string.t	1.63 KB	-r--r--r--	2014-12-27 11:48
12_write.t	2.72 KB	-r--r--r--	2014-12-27 11:48
13_write_string.t	642 B	-r--r--r--	2014-12-27 11:48
20_subclass.t	1005 B	-r--r--r--	2014-12-27 11:48
21_yamlpm_compat.t	1.64 KB	-r--r--r--	2014-12-27 11:48
30_yaml_spec_tml.t	929 B	-r--r--r--	2014-12-27 11:48
31_local_tml.t	482 B	-r--r--r--	2014-12-27 11:48
32_world_tml.t	186 B	-r--r--r--	2014-12-27 11:48
README.md	6.15 KB	-r--r--r--	2014-12-27 11:48
tml	3.3 KB	-r-xr-xr-x	2014-12-27 11:48

Rename

use utf8;
use strict;
use warnings;
use lib 't/lib/';
use Test::More 0.99;
use TestBridge;
use TestUtils;

use CPAN::Meta::YAML;
use File::Basename qw/basename/;
use File::Temp qw/tempfile/;

#--------------------------------------------------------------------------#
# Error conditions
#--------------------------------------------------------------------------#

subtest 'no filename for write()' => sub {
    my $obj = CPAN::Meta::YAML->new();
    eval { $obj->write(); };
    error_like( qr/You did not specify a file name/,
        "No filename provided to write()"
    );
};

#--------------------------------------------------------------------------#
# Test that write uses correct encoding and can round-trip
#--------------------------------------------------------------------------#

my @cases = (
    { label => "ascii",  name => "Mengue" },
    { label => "latin1", name => "Mengué" },
    { label => "wide",   name => "あ"     },
);

my @warnings;
local $SIG{__WARN__} = sub { push @warnings, $_[0] };

# CPAN::Meta::YAML doesn't preserve order in the file, so we can't actually check
# file equivalence.  We have to see if we can round-trip a data structure
# from Perl to YAML and back.
for my $c ( @cases ) {
    subtest "write $c->{label} characters" => sub {
        my $data;
        @warnings = ();

# get a tempfile name to write to
        my ($fh, $tempfile) = tempfile("YAML-Tiny-test-XXXXXXXX", TMPDIR => 1 );
        my $short_tempfile = basename($tempfile);
        close $fh; # avoid locks on windows

# CPAN::Meta::YAML->write
        ok( CPAN::Meta::YAML->new($c)->write($tempfile),
            "case $c->{label}: write $short_tempfile" )
            or diag "ERROR: " . CPAN::Meta::YAML->errstr;

# CPAN::Meta::YAML->read
        ok( $data = eval { CPAN::Meta::YAML->read( $tempfile ) },
            "case $c->{label}: read $short_tempfile" )
            or diag "ERROR: " . CPAN::Meta::YAML->errstr;
        is( $@, '', "no error caught" );
        SKIP : {
            skip "no data read", 1 unless $data;
            cmp_deeply( $data, [ $c ],
                "case $c->{label}: Perl -> File -> Perl roundtrip" );
        }

# CPAN::Meta::YAML->read_string on UTF-8 decoded data
        ok( $data = eval { CPAN::Meta::YAML->read_string( slurp($tempfile, ":utf8") ) },
            "case $c->{label}: read_string on UTF-8 decoded $short_tempfile" );
        is( $@, '', "no error caught" );
        SKIP : {
            skip "no data read", 1 unless $data;
            cmp_deeply( $data, [ $c ],
                "case $c->{label}: Perl -> File -> Decoded -> Perl roundtrip" );
        }

is( scalar @warnings, 0, "case $c->{label}: no warnings caught" )
            or diag @warnings;
    }
}

done_testing;