view release on metacpan or  search on metacpan

t/02-accel-selection.t  view on Meta::CPAN

		for my $i ( 0 .. $#$sc ) {
			my $d = abs( $sc->[$i] - $sp->[$i] );
			$max_diff = $d if $d > $max_diff;
		}
		cmp_ok( $max_diff, '<', 1e-9, "C and Perl scores agree (max diff $max_diff)" );

		# Labels at the default cutoff must match exactly.
		my $lc         = $fc->predict( \@data );
		my $lp         = $fp->predict( \@data );
		my $mismatches = grep { $lc->[$_] != $lp->[$_] } 0 .. $#$lc;
		is( $mismatches, 0, 'predict() labels agree across backends' );
	}; ## end 'C-backed and Perl-fallback scores agree' => sub
} ## end SKIP:

SKIP: {
	skip 'OpenMP not linked in', 1 unless $HAS_OPENMP;

	subtest 'use_openmp => 0 keeps C backend, disables parallel walk' => sub {
		my $f = $CLASS->new(
			n_trees     => 20,
			sample_size => 32,
			seed        => 3,
			use_openmp  => 0,
		);
		is( $f->{_use_c},      1, '_use_c stays on with use_openmp => 0' );
		is( $f->{_use_openmp}, 0, '_use_openmp is 0 after use_openmp => 0' );

		$f->fit( \@data );
		my $scores = $f->score_samples( \@data );
		is( scalar @$scores, scalar @data, 'serial C path still scores every sample' );
	}; ## end 'use_openmp => 0 keeps C backend, disables parallel walk' => sub

	subtest 'use_openmp => 1 honoured when $HAS_OPENMP is set' => sub {
		my $f = $CLASS->new(
			n_trees     => 20,
			sample_size => 32,
			seed        => 3,
			use_openmp  => 1,
		);
		is( $f->{_use_openmp}, 1, '_use_openmp is 1 after use_openmp => 1' );
	};
} ## end SKIP:

subtest 'use_openmp clamped to 0 when use_c is off' => sub {
	# OpenMP only matters with the C tree walk; if the C backend is off
	# the OpenMP flag is meaningless, so the constructor should clear it
	# rather than leaving it set to a value that never gets read.
	my $f = $CLASS->new(
		n_trees     => 10,
		sample_size => 16,
		seed        => 1,
		use_c       => 0,
		use_openmp  => 1,
	);
	is( $f->{_use_c},      0, '_use_c is 0' );
	is( $f->{_use_openmp}, 0, '_use_openmp clamped to 0 since C backend is off' );
}; ## end 'use_openmp clamped to 0 when use_c is off' => sub

subtest 'use_c => 1 clamped against $HAS_C in the constructor' => sub {
	# Fake "no Inline::C compiled" by localising the package flags.  The
	# XS subs themselves remain defined in this process (they were loaded
	# at module init), but the constructor's contract is to clamp against
	# $HAS_C so a fresh build without Inline::C wouldn't end up calling
	# an undefined sub at score time.
	local $Algorithm::Classifier::IsolationForest::HAS_C      = 0;
	local $Algorithm::Classifier::IsolationForest::HAS_OPENMP = 0;

	my $f = $CLASS->new(
		n_trees     => 10,
		sample_size => 16,
		seed        => 1,
		use_c       => 1,
		use_openmp  => 1,
	);
	is( $f->{_use_c},      0, 'use_c => 1 clamped to 0 when $HAS_C is 0' );
	is( $f->{_use_openmp}, 0, 'use_openmp => 1 clamped to 0 when $HAS_OPENMP is 0' );

	# Defaults follow the (faked) flags too.
	my $g = $CLASS->new( n_trees => 10, sample_size => 16, seed => 1 );
	is( $g->{_use_c},      0, 'default _use_c follows the faked $HAS_C' );
	is( $g->{_use_openmp}, 0, 'default _use_openmp follows the faked $HAS_OPENMP' );
}; ## end 'use_c => 1 clamped against $HAS_C in the constructor' => sub

subtest 'use_openmp => 1 clamped against $HAS_OPENMP' => sub {
	# $HAS_C stays on so the C backend is still picked up; only OpenMP
	# is faked off.  use_openmp => 1 should clamp to 0.
	local $Algorithm::Classifier::IsolationForest::HAS_OPENMP = 0;

	my $f = $CLASS->new(
		n_trees     => 10,
		sample_size => 16,
		seed        => 1,
		use_openmp  => 1,
	);
	is( $f->{_use_c},      $HAS_C, '_use_c follows $HAS_C' );
	is( $f->{_use_openmp}, 0,      'use_openmp => 1 clamped to 0 when $HAS_OPENMP is 0' );
}; ## end 'use_openmp => 1 clamped against $HAS_OPENMP' => sub

subtest 'pack_data croaks when use_c is off' => sub {
	my $f = $CLASS->new(
		n_trees     => 10,
		sample_size => 20,
		seed        => 9,
		use_c       => 0,
	);
	$f->fit( \@data );
	eval { $f->pack_data( \@data ) };
	like( $@, qr/requires the Inline::C backend/, 'pack_data refuses to run without the C backend' );
}; ## end 'pack_data croaks when use_c is off' => sub

# ------------------------------------------------------------------------
# CLI: `iforest accel` should run cleanly and report a status consistent
# with the package flags this process sees.  We bypass it entirely if
# bin/iforest isn't there (e.g. unusual install layouts).
# ------------------------------------------------------------------------
SKIP: {
	my $bin = File::Spec->rel2abs('bin/iforest');
	skip "bin/iforest not found", 1 unless -x $bin;

	subtest 'iforest accel CLI reports a consistent status' => sub {
		my $out = `$^X -Ilib $bin accel 2>&1`;
		is( $?, 0, 'iforest accel exits 0' );

		like( $out, qr/Algorithm::Classifier::IsolationForest acceleration status/, 'prints the status header' );
		like( $out, qr/Inline::C\s*:/,                                              'mentions Inline::C' );
		like( $out, qr/OpenMP\s*:/,                                                 'mentions OpenMP' );
		like( $out, qr/SIMD\s*:/,                                                   'mentions SIMD' );
		like( $out, qr/C object\s*:/,                                               'mentions the C object source' );
		like( $out, qr/Active backend:/,                                            'prints an Active backend line' );

		# The C object line must always resolve to one of the three
		# states, consistent with the availability row in the same
		# output (the CLI runs in its own process, so we compare the
		# CLI's output against itself, not against this process's
		# flags -- prebuilt vs runtime may legitimately differ).
		if ( $out =~ /Inline::C\s*:\s*available/ ) {
			like(
				$out,
				qr/C object\s*:\s*(prebuilt at install time|compiled at run time)/,
				'C object line says prebuilt or runtime when C is active'
			);
			like(
				$out,
				qr/Active backend:.*-- (prebuilt at install time|compiled at run time)/,
				'Active backend summary includes the C object source'
			);
		} else {
			like( $out, qr/C object\s*:\s*none/, 'C object line says none without a C backend' );
		}

		# Cross-check the per-feature status lines against the package
		# flags the test process observed.  This is what makes this test
		# actually verify selection rather than just "doesn't crash".
		if ($HAS_C) {
			like( $out, qr/Inline::C\s*:\s*available/, 'CLI reports Inline::C available, matching $HAS_C' );
		} else {
			like( $out, qr/Inline::C\s*:\s*not available/, 'CLI reports Inline::C not available, matching $HAS_C' );
		}
		if ($HAS_OPENMP) {
			like( $out, qr/OpenMP\s*:\s*available/, 'CLI reports OpenMP available, matching $HAS_OPENMP' );
		} else {
			like( $out, qr/OpenMP\s*:\s*not available/, 'CLI reports OpenMP not available, matching $HAS_OPENMP' );
		}
		if ($HAS_SIMD) {
			like( $out, qr/SIMD\s*:\s*available/, 'CLI reports SIMD available, matching $HAS_SIMD' );
		} else {
			like( $out, qr/SIMD\s*:\s*not available/, 'CLI reports SIMD not available, matching $HAS_SIMD' );
		}

		# The "Active backend:" summary should reflect the same picture.
		if ( $HAS_C && ( $HAS_OPENMP || $HAS_SIMD ) ) {
			like( $out, qr/Active backend:\s*Inline::C with /, 'summary names Inline::C plus features' );
		} elsif ($HAS_C) {
			like(
				$out,
				qr/Active backend:\s*Inline::C \(serial, scalar\)/,
				'summary names serial/scalar Inline::C'
			);
		} else {
			like( $out, qr/Active backend:\s*pure Perl/, 'summary falls back to pure Perl' );
		}
	}; ## end 'iforest accel CLI reports a consistent status' => sub
} ## end SKIP:

diag( sprintf 'test ran with HAS_C=%d HAS_OPENMP=%d HAS_SIMD=%d', $HAS_C, $HAS_OPENMP, $HAS_SIMD );

done_testing;