view release on metacpan or  search on metacpan

t/extended_tests.t  view on Meta::CPAN

		'new("") croaks: defined empty string fails the length guard';

	# Test::Returns: the call croaks, so there is no return value to check.
	# Verify the error message is exactly right by re-testing with explicit match.
	throws_ok { Class::Abstract::new('') }
		qr/new\(\) requires a defined class name as invocant/,
		'new("") error message matches documented text exactly';
};

# Purpose: check_abstract("") must croak -- same guard, same condition
subtest 'check_abstract("") -- defined-but-empty class name croaks' => sub {
	plan tests => 2;

	throws_ok { Class::Abstract::check_abstract('') }
		$config{err_chk_undef},
		'check_abstract("") croaks: defined empty string fails the length guard';

	throws_ok { Class::Abstract::check_abstract('') }
		qr/check_abstract\(\) requires a defined class name/,
		'check_abstract("") error message matches documented text exactly';
};

# ===========================================================================
# SECTION 3: Production scenario
#
# The 'l&&!r' condition for the bypass guard in new() and check_abstract() is:
#   $config{harness_bypass} is truthy (default=1)
#   $ENV{HARNESS_ACTIVE} is NOT set (empty string or undef)
#
# This is the real-world production scenario: code runs outside a test harness
# with all defaults.  Enforcement must fire because
#   $BYPASS=0 AND ($harness_bypass=1 AND $HARNESS_ACTIVE='') = 0 || 0 = false.
# ===========================================================================

# Purpose: enforcement fires in production context (no harness, no bypass)
subtest 'production scenario -- enforcement fires with defaults outside harness' => sub {
	plan tests => 4;

	diag 'Testing production context: BYPASS=0, harness_bypass=1, HARNESS_ACTIVE=""'
		if $ENV{TEST_VERBOSE};

	# new(): BYPASS=0, harness_bypass=1 (default), HARNESS_ACTIVE="" (not in harness)
	{
		local $Class::Abstract::BYPASS                 = 0;
		local $Class::Abstract::config{harness_bypass} = $config{harness_bypass_on};
		local $ENV{HARNESS_ACTIVE}                     = $config{harness_active_off};

		throws_ok { ET::Abstract->new() }
			$config{err_abstract},
			'new() croaks in production: BYPASS=0, harness_bypass=1, HARNESS_ACTIVE=""';
	}

	# new(): verify concrete class still works in the same context
	{
		local $Class::Abstract::BYPASS                 = 0;
		local $Class::Abstract::config{harness_bypass} = $config{harness_bypass_on};
		local $ENV{HARNESS_ACTIVE}                     = $config{harness_active_off};

		my $obj;
		lives_ok { $obj = ET::Concrete->new() }
			'new(concrete) lives in production context (only abstract class is blocked)';
		ok blessed($obj), 'concrete object is blessed in production context';
	}

	# check_abstract(): same production context
	{
		local $Class::Abstract::BYPASS                 = 0;
		local $Class::Abstract::config{harness_bypass} = $config{harness_bypass_on};
		local $ENV{HARNESS_ACTIVE}                     = $config{harness_active_off};

		throws_ok { Class::Abstract::check_abstract($config{pkg_abstract}) }
			$config{err_abstract},
			'check_abstract() croaks in production: same default context';
	}
};

# ===========================================================================
# SECTION 4: new() with blessed abstract-class instance as invocant
#
# When a blessed object of an abstract class is passed as invocant, new()
# extracts the class name via blessed() then checks if that class is abstract.
# With enforcement on, the croak must fire because the extracted class IS abstract.
#
# This tests the LCSAJ path:
#   if(ref): T -> unless(blessed): F -> class=ref(obj) -> bypass: off -> abstract: T -> CROAK
# ===========================================================================

# Purpose: blessed instance of abstract class passed to new() -- croak after class extraction
subtest 'new() -- blessed abstract-class instance causes enforcement after class extraction' => sub {
	plan tests => 3;

	# Create a blessed abstract instance (bypass must be on to create it)
	my $abstract_obj;
	{
		local $Class::Abstract::BYPASS = 1;
		$abstract_obj = ET::Abstract->new();
	}

	diag 'abstract obj class: ' . (blessed($abstract_obj) // 'undef') if $ENV{TEST_VERBOSE};

	# Precondition: the object exists and is blessed into the abstract class
	ok blessed($abstract_obj), 'precondition: abstract object created with bypass';
	is ref($abstract_obj), $config{pkg_abstract},
		'precondition: object is blessed into ET::Abstract';

	# With enforcement on, new($abstract_obj) must croak:
	# ref branch -> class = 'ET::Abstract' -> abstract check -> croak
	enforcement_on {
		throws_ok { Class::Abstract::new($abstract_obj) }
			qr/Cannot instantiate abstract class ET::Abstract directly/,
			'new(blessed abstract obj): croak after class extraction from blessed ref';
	};
};

# ===========================================================================
# SECTION 5: check_abstract() with concrete class and blessed object invocant
#
# check_abstract() must silently return undef when the class is concrete.
# Also tests the path where a blessed concrete OBJECT is passed as invocant
# (ref branch: truthy -> blessed: truthy -> class extracted from ref).
# ===========================================================================