view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

		is ref($obj), $config{pkg_abstract},
			'SECURITY: resulting object is blessed into the abstract class';
	};
};

# ===========================================================================
# SECTION 14: Context sensitivity for is_abstract()
#
# is_abstract() returns a scalar integer.  In list context it must still
# deliver a single meaningful value.  In boolean context the result must
# be truthy for abstract classes and falsy for concrete ones.
# ===========================================================================

# Purpose: is_abstract() behaves consistently across calling contexts
subtest 'is_abstract() -- consistent in list, scalar, and boolean contexts' => sub {
	plan tests => 5;

	# List context: must return a list of exactly one element
	my @list = EC::Abstract->is_abstract();
	is scalar @list, 1,
		'is_abstract() in list context returns a 1-element list';

	is $list[0], $TRUE,
		'is_abstract() list context: first element is 1 for abstract class';

	# Scalar context: must return the integer 1 for abstract class
	my $scalar = EC::Abstract->is_abstract();
	is $scalar, $TRUE,
		'is_abstract() in scalar context returns 1 for abstract class';

	# Boolean context: abstract must be truthy, concrete must be falsy.
	# Explicit parens prevent 'ok CLASS->method' being parsed as 'CLASS->ok(...)'.
	ok( EC::Abstract->is_abstract(),
		'EC::Abstract->is_abstract() is truthy in boolean context' );

	ok( !EC::Concrete->is_abstract(),
		'EC::Concrete->is_abstract() is falsy in boolean context' );
};

# ===========================================================================
# SECTION 15: Weakened reference as invocant
#
# Scalar::Util::weaken() removes the strong reference count.  Once all
# strong references are gone the object is destroyed and the weak ref becomes
# undef.  A live (still-referenced) weakened blessed ref must pass new().
# A dead (garbage-collected) weakened ref becomes undef and must croak.
# ===========================================================================

# Purpose: live weakened blessed ref works; dead weakened ref croaks
subtest 'weakened references as invocants' => sub {
	plan tests => 3;

	# Live weak ref: a strong ref also exists, so the object survives
	my $strong = EC::Concrete->new();
	my $weak   = $strong;
	weaken($weak);

	diag 'weak ref: ' . (defined($weak) ? ref($weak) : 'undef') if $ENV{TEST_VERBOSE};

	# $weak is still alive because $strong holds a strong reference
	ok defined($weak) && blessed($weak),
		'precondition: weakened ref is still alive (strong ref holds it)';

	# A live weakened blessed ref must be accepted by new()
	lives_ok { $strong->new() }
		'live weakened blessed ref: new() succeeds via strong ref';

	# Dead weak ref: no strong references, object is garbage-collected immediately
	my $dead_weak = do { my $obj = EC::Concrete->new(); weaken($obj); $obj };

	# The dead weak ref is undef; ref(undef) = "", so it hits the undef guard
	throws_ok { Class::Abstract::new($dead_weak) }
		$config{err_new_undef},
		'dead weakened ref (undef) causes new() to croak with defined-class-name error';
};

# ===========================================================================
# SECTION 16: $_ is never clobbered by any public method
#
# Any grep or map over @ISA inside _is_direct_abstract could overwrite $_.
# Verify $_ is unchanged across all four public methods under varied inputs.
# ===========================================================================

# Purpose: no public method may mutate $_ in the calling scope
subtest '$_ not clobbered by any public method under varied inputs' => sub {
	plan tests => 4;

	# Use a value containing characters that would cause obvious corruption
	Readonly::Scalar my $SENTINEL => 'SENTINEL_DO_NOT_MUTATE';

	# import() must leave $_ alone
	{
		local $_ = $SENTINEL;
		{ package EC::DontClobberImport; our @ISA = (); Class::Abstract->import() }
		is $_, $SENTINEL, '$_ unchanged after import()';
	}

	# new() must leave $_ alone
	{
		local $_ = $SENTINEL;
		EC::Concrete->new();
		is $_, $SENTINEL, '$_ unchanged after new()';
	}

	# check_abstract() must leave $_ alone
	{
		local $_ = $SENTINEL;
		enforcement_on { Class::Abstract::check_abstract($config{pkg_concrete}) };
		is $_, $SENTINEL, '$_ unchanged after check_abstract()';
	}

	# is_abstract() must leave $_ alone (grep on @ISA is the risk)
	{
		local $_ = $SENTINEL;
		EC::Abstract->is_abstract();
		EC::Concrete->is_abstract();
		Class::Abstract->is_abstract($config{pkg_abstract});
		is $_, $SENTINEL, '$_ unchanged after multiple is_abstract() calls';
	}
};

done_testing;