view release on metacpan or  search on metacpan

t/20-script-encoding.t  view on Meta::CPAN

use Test2::V0 -no_pragmas => 1;
use Test2::Tools::Command;

use lib 't/lib';
use Test2::Require::WorkingUtf8;

use warnings;
use strict;

use Encode::Locale;
use Encode 2.12 qw(decode encode);
use Path::Tiny 0.053;

if ( $Encode::Locale::ENCODING_LOCALE ne 'UTF-8' ) {
	skip_all
		"locale encoding is $Encode::Locale::ENCODING_LOCALE - we need UTF-8";
}

plan 13;

diag 'locale encoding: ', $Encode::Locale::ENCODING_LOCALE;

local @Test2::Tools::Command::command = ( $^X, 'bin/licensecheck' );
if ( $ENV{'LICENSECHECK'} ) {
	@Test2::Tools::Command::command = ( $ENV{'LICENSECHECK'} );
}
elsif ( path('blib')->exists ) {
	@Test2::Tools::Command::command = ('blib/script/licensecheck');
}
push @Test2::Tools::Command::command, qw(--machine --debug --copyright);

# avoid Log::Any::Adapter::Screen log noise
delete(
	@ENV{
		'NO_COLOR',   'COLOR',
		'LOG_PREFIX', 'LOG_LEVEL',
		'QUIET',      'VERBOSE', 'DEBUG', 'TRACE'
	}
);

my $basic
	= "t/encoding/copr-utf8.h\tGNU General Public License v2.0 or later\t2004-2015 Oliva 'f00' Oberto / 2001-2010 Paul 'bar' Stevénsön\n";
my $basic_utf8           = encode( 'utf8', $basic );
my $basic_utf8_as_latin1 = decode( 'iso-8859-1', encode( 'utf8', $basic ) );

my $extended
	= "t/encoding/copr-iso8859.h\tGNU General Public License, Version 2 [obsolete FSF postal address (Temple Place)]\t2011 Heinrich Müller <henmull\@src.gnome.org>\n";
my $extended_latin1 = encode( 'iso-8859-1', $extended );

my $japanese
	= "t/encoding/README.gs550j\tUNKNOWN\t1999 大森紀人 (ohmori\@p.chiba-u.ac.jp) / 1999 Norihito Ohmori. / 1996-1999 Daisuke SUZUKI.\n";

# TODO: generate japanese mojibake
my $japanese_ujis_as_latin1
	= "t/encoding/README.gs550j\tUNKNOWN\t1999 Â翹µª¿Í (ohmori\@p.chiba-u.ac.jp) / 1999 Norihito Ohmori. / 1996-1999 Daisuke SUZUKI.\n";
my $japanese_ujis_raw = $japanese_ujis_as_latin1;
utf8::upgrade($japanese_ujis_raw);

subtest 'Latin-1 in UTF-8 parsed as UTF-8 returns chars' => sub {
	command {
		args   => [qw(--encoding utf8 t/encoding/copr-utf8.h)],
		stdout => $basic,
		stderr => qr/ as utf8\nheader end matches file size\nresolved/,
	};
};
subtest 'Latin-1 in UTF-8 parsed by default returns mojibake' => sub {
	command {
		args   => [qw(t/encoding/copr-utf8.h)],
		stdout => qr//,
		stderr => qr/ as raw bytes\nheader end matches file size\nresolved/,
	};
	my $todo = todo 'String::Copyright documented to accept only strings';
	command {
		args   => [qw(t/encoding/copr-utf8.h)],
		stdout => $basic_utf8_as_latin1,
		stderr => qr/ as raw bytes\nheader end matches file size\nresolved/,
	};
	$todo = undef;
};
subtest 'Latin-1 in UTF-8 parsed by guessing returns chars' => sub {
	command {