The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl

use strict;
use warnings;
use Test::More;
BEGIN {
	$| = 1; # flush for the threads
	unless ( $ENV{DISPLAY} or $^O eq 'MSWin32' ) {
		plan skip_all => 'Needs DISPLAY';
		exit 0;
	}
	if ( $^O eq 'MSWin32' ) {
		plan skip_all => 'Windows currently has too many problems with this. Please fix!';
		exit(0);
	}
}
use threads;         # need to be loaded before Padre
use threads::shared; # need to be loaded before Padre
use t::lib::Padre;
use Padre::Service;

# secret Task class name accessible in the test threads. See also way below
our $TestClass;

# reminiscent of the in-thread worker loop in Padre::TaskManager:
sub fake_run_task {
	my $string = shift;
	my $spec   = shift;
	# try to recover the serialized task from its Storable-dumped form to an object
	my $recovered = Padre::Task->deserialize( \$string );

	ok(defined $recovered, "recovered form defined");
	isa_ok($recovered, 'Padre::Task');
	isa_ok($recovered, $TestClass); # a subcalss of Padre::Task
	#is_deeply($recovered, $task);
	
	# Test the execution in the main thread in case worker threads are disabled
	if (threads->tid() == 0) { # main thread
		ok( exists($recovered->{main_thread_only})
		    && not exists($recovered->{_main_thread_data_id}),
		    && $recovered->{main_thread_only} eq 'not in sub thread',
		    "main-thread data stays available in main thread" );
	}
	# Test the execution in a worker thread
	else {
		ok( not exists($recovered->{main_thread_only}),
		    && exists($recovered->{_main_thread_data_id}),
		    "main-thread data not available in worker thread" );
	}
	
	# call the test task's run method
	$recovered->run();
	$string = undef;
	# ship the thing back at the end
	$recovered->serialize(\$string);
	return $string;
}

# helper sub that runs a test task. Reminiscent of what the user would do
# plus what the scheduler does
sub fake_execute_task {
	my $class           = shift;
	my $test_spec       = shift;
	my $use_threads     = $test_spec->{threading};
	my $extra_data      = $test_spec->{extra_data}||{};
	my $tests_in_thread = $test_spec->{thread_tests}||0;
	my $tb = Test::Builder->new;
	# normally user code:
	$class->new(text => 'foo'); # FIXME necessary for the following to pass for Padre::Task::PPITest???
	ok($class->can('new'), "task can be constructed");
	my $task = $class->new( main_thread_only => "not in sub thread", %$extra_data );
	isa_ok($task, 'Padre::Task');
	isa_ok($task, $class);
	ok($task->can('prepare'), "can prepare");
	
	# done by the scheduler:
	$task->prepare();
	my $string;
	$task->serialize(\$string);
	ok(defined $string, "serialized form defined");

	if ($use_threads) {
		my $thread = threads->create(
			\&fake_run_task, $string, $test_spec
		);
		$string = $thread->join();
		$tb->current_test( $tb->current_test()+ $tests_in_thread);
		isa_ok($thread, 'threads');
	}
	else {
		$string = fake_run_task($string);
		$tb->current_test( $tb->current_test()+ $tests_in_thread);
		ok($string, 'Returned from unthreaded service !');;
	}

	# done by the scheduler:
	my $final = Padre::Task->deserialize( \$string );
	ok(defined $final);
	ok(not exists $task->{answer});

	TODO: { 
		local $TODO = 'Cleanup the shambolic references in ::Service de/serialize';
		is_deeply($final, $task);
	}
	
	$task->{answer} = 'succeed';
	$final->finish();
}

package main;

# simple service test
$TestClass = "Padre::Service";
my $testspec = { threading => 0, thread_tests => 11, };
fake_execute_task($TestClass, $testspec);

# threaded service test
$testspec->{threading} = 1;
$testspec->{thread_tests} += 4; # serializer/tests 
fake_execute_task($TestClass, $testspec);
done_testing();
=pod

# PPI subtask test
$TestClass = "Padre::Task::PPITest";
$testspec->{thread_tests} = 11;
$testspec->{extra_data} = {text => q(my $self = shift;)};
$testspec->{threading} = 0;
fake_execute_task($TestClass, $testspec);

$testspec->{threading} = 1;
fake_execute_task($TestClass, $testspec);

=cut