view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

#!/usr/bin/env perl

# Destructive, boundary, and security edge-case tests for Encode::Wide.
#
# Strategy: feed hostile, malformed, or pathological inputs to every code
# path and verify the module either handles them gracefully (no crash, no
# state corruption, pure-ASCII output) or dies with a clearly documented
# error.  All tests assert INTENDED behaviour per the POD, not accidental
# behaviour.  Coverage already in edge.t / unit.t / integration.t is not
# repeated here.

use strict;
use warnings;

use Test::Most;
use Test::Mockingbird qw(mock restore_all);
use Readonly;

# ---------------------------------------------------------------------------
# Constants
# ---------------------------------------------------------------------------

Readonly::Scalar my $MODULE   => 'Encode::Wide';
Readonly::Scalar my $E_ACUTE  => "\x{00E9}";	# U+00E9 e-acute
Readonly::Scalar my $A_GRAVE  => "\x{00E0}";	# U+00A0 a-grave
Readonly::Scalar my $NBSP     => "\x{00A0}";	# U+00A0 non-breaking space
Readonly::Scalar my $BOM      => "\x{FEFF}";	# U+FEFF byte-order mark
Readonly::Scalar my $ELLIPSIS => "\x{2026}";	# U+2026 horizontal ellipsis
Readonly::Scalar my $BULLET   => "\x{25CF}";	# U+25CF black circle
Readonly::Scalar my $LSQUO    => "\x{2018}";	# U+2018 left single quotation mark
Readonly::Scalar my $RSQUO    => "\x{2019}";	# U+2019 right single quotation mark
Readonly::Scalar my $LDQUO    => "\x{201C}";	# U+201C left double quotation mark
Readonly::Scalar my $RDQUO    => "\x{201D}";	# U+201D right double quotation mark
Readonly::Scalar my $PUA      => "\x{E000}";	# U+E000 private-use (unmapped -> BUG die)
Readonly::Scalar my $LARGE_N  => 10_000;	# repeat count for stress tests

use_ok($MODULE, qw(wide_to_html wide_to_xml));

# ===========================================================================
# 1. Numerically-false but defined scalars
# ---------------------------------------------------------------------------
# The POD says string must be *defined*.  "0" and integer 0 are defined and
# must pass through without dying, returning pure ASCII.
# ===========================================================================

subtest 'Numerically false string "0" is not treated as undef' => sub {
	# If the module checked `if(!$string)` rather than `if(!defined($string))`
	# it would incorrectly die for "0".
	lives_ok { wide_to_html(string => '0') } 'html: string "0" does not die';
	lives_ok { wide_to_xml(string  => '0') } 'xml:  string "0" does not die';
	is(wide_to_html(string => '0'), '0', 'html: string "0" returns "0"');
	is(wide_to_xml(string  => '0'), '0', 'xml:  string "0" returns "0"');
};

subtest 'Integer 0 as string argument is not treated as undef' => sub {
	lives_ok { wide_to_html(string => 0) } 'html: integer 0 does not die';
	lives_ok { wide_to_xml(string  => 0) } 'xml:  integer 0 does not die';
	is(wide_to_html(string => 0), '0', 'html: integer 0 returns "0"');
	is(wide_to_xml(string  => 0), '0', 'xml:  integer 0 returns "0"');
};

subtest 'Single-space string is not treated as undef' => sub {
	is(wide_to_html(string => ' '), ' ', 'html: space string returns " "');
	is(wide_to_xml(string  => ' '), ' ', 'xml:  space string returns " "');
};

# ===========================================================================
# 2. NUL and DEL characters (ASCII boundary codepoints)
# ---------------------------------------------------------------------------
# U+0000 (NUL) and U+007F (DEL) are ASCII.  They are not wide characters,
# so neither pipeline should alter them.
# ===========================================================================

subtest 'NUL byte (U+0000) passes through unchanged' => sub {
	my $nul = "\x{0000}";
	is(wide_to_html(string => $nul),         $nul,       'html: bare NUL unchanged');
	is(wide_to_xml(string  => $nul),         $nul,       'xml:  bare NUL unchanged');
	is(wide_to_html(string => "a${nul}b"),   "a${nul}b", 'html: NUL in middle unchanged');
	is(wide_to_xml(string  => "a${nul}b"),   "a${nul}b", 'xml:  NUL in middle unchanged');
};

subtest 'DEL character (U+007F) passes through unchanged' => sub {
	my $del = "\x{007F}";
	is(wide_to_html(string => $del), $del, 'html: DEL unchanged');
	is(wide_to_xml(string  => $del), $del, 'xml:  DEL unchanged');
};

# ===========================================================================
# 3. Byte-Order Mark (U+FEFF)
# ---------------------------------------------------------------------------
# BOM is non-ASCII and not in any known byte_map entry.  It should reach the
# HTML::Entities::encode_entities_numeric fallback and become a numeric entity.
# At minimum the output must be pure ASCII.
# ===========================================================================

subtest 'BOM (U+FEFF) is handled per documented pipeline behaviour' => sub {
	# HTML: encode_entities_numeric covers U+FEFF -> numeric entity -> pure ASCII.
	my $html_bom;
	open(local *STDERR, '>', '/dev/null') or die;
	local $SIG{__WARN__} = sub { };
	lives_ok { $html_bom = wide_to_html(string => $BOM) } 'html: BOM does not die';
	unlike($html_bom, qr/[^[:ascii:]]/, 'html: BOM result is pure ASCII');
	diag "html BOM: $html_bom" if $ENV{TEST_VERBOSE};

	# XML: U+FEFF is not in any XML byte_map entry; the documented BUG path fires.
	open(local *STDERR, '>', '/dev/null') or die;
	local $SIG{__WARN__} = sub { };
	throws_ok { wide_to_xml(string => $BOM) }
		qr/BUG: wide_to_xml/,
		'xml: BOM (unmapped in XML maps) triggers documented BUG die';
};

# ===========================================================================
# 4. Hostile reference types
# ---------------------------------------------------------------------------
# Passing ARRAYREF, HASHREF, or CODEREF as string is outside the POD contract.
# The module must not produce non-ASCII output, must not execute injected code,
# and must not hang or corrupt memory.  It may die.
# ===========================================================================

subtest 'ARRAYREF as string: terminates, no non-ASCII output' => sub {
	my $aref = [1, 2, 3];
	for my $fn (qw(wide_to_html wide_to_xml)) {
		no strict 'refs';
		my $result;
		eval { $result = $fn->(string => $aref) };
		if($@) {
			diag "$fn: arrayref caused die (acceptable): $@" if $ENV{TEST_VERBOSE};
			pass("$fn: arrayref input terminated (die acceptable)");
		} else {
			unlike($result, qr/[^[:ascii:]]/, "$fn: arrayref stringification is ASCII");
		}
	}
};

subtest 'HASHREF as string: terminates, no non-ASCII output' => sub {
	my $href = { key => 'val' };
	for my $fn (qw(wide_to_html wide_to_xml)) {
		no strict 'refs';
		my $result;
		eval { $result = $fn->(string => $href) };
		if($@) {
			pass("$fn: hashref input terminated (die acceptable)");
		} else {
			unlike($result, qr/[^[:ascii:]]/, "$fn: hashref stringification is ASCII");
		}
	}
};

subtest 'CODEREF as string: terminates, no non-ASCII output' => sub {
	my $cref = sub { 42 };
	for my $fn (qw(wide_to_html wide_to_xml)) {
		no strict 'refs';
		my $result;
		eval { $result = $fn->(string => $cref) };
		if($@) {
			pass("$fn: coderef input terminated (die acceptable)");
		} else {
			unlike($result, qr/[^[:ascii:]]/, "$fn: coderef stringification is ASCII");
		}
	}
};

# ===========================================================================
# 5. Circular scalar reference (must not infinite-loop)
# ---------------------------------------------------------------------------
# A scalar variable that references itself is hostile input that could cause
# an infinite deref loop in naive code.  The module must terminate within a
# reasonable time because it only follows one level of SCALARREF dereference.
# ===========================================================================