#
# (C) Copyright 2011-2018 Sergey A. Babkin.
# This file is a part of Triceps.
# See the file COPYRIGHT for the copyright notice and license information
#
# The test for error handling and wrapping.

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Triceps.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use ExtUtils::testlib;

use Test;
BEGIN { plan tests => 18 };
use Triceps;
ok(1); # If we made it this far, we're ok.

#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

###################### new #################################

$u1 = Triceps::Unit->new("u1");
ok(ref $u1, "Triceps::Unit");

@def1 = (
	a => "uint8",
	b => "int32",
	c => "int64",
	d => "float64",
	e => "string",
);
$rt1 = Triceps::RowType->new( # used later
	@def1
);
ok(ref $rt1, "Triceps::RowType");

@baddef = (
	a => "badtype",
);

@dataset1 = (
	a => 123,
	b => 456,
	c => 789,
	d => 3.14,
	e => "text",
);
# @datavalues1 = (123, 456, 789, 3.14, "text");
$row1 = $rt1->makeRowHash(@dataset1);
ok(ref $row1, "Triceps::Row");

# recursive label
$reclab = $u1->makeLabel($rt1, "reclab", undef, sub { $u1->call($_[1]); } );
ok(ref $reclab, "Triceps::Label");
$recrop = $reclab->makeRowop("OP_INSERT", $row1);

#############################################################
# nestfess handling an error from XS

sub makeBadRowType
{
	Triceps::RowType->new(@baddef);
}

eval {
	my $result_rt = eval { makeBadRowType(); };
	if ($@) { Triceps::nestfess("Nested error:", $@); }
};
#print "$@";
ok($@, qr/^Nested error:
  Triceps::RowType::new: field 'a' has an unknown type 'badtype'
  Triceps::RowType::new: The specification was: \{
    a => badtype
  \} at .*
	main::makeBadRowType\(\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# nestfess handling a manual confess and cutting its stack

sub throwAnError
{
	Carp::confess "A manual error";
}

eval {
	my $result_rt = eval { throwAnError(); };
	if ($@) { Triceps::nestfess("Nested error:", $@); }
};
#print "$@";
ok($@, qr/^Nested error:
  A manual error at .*
	main::throwAnError\(\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# nestfess handling a manual confess and cutting its stack,
# with multiple levels of eval {...}

my $msg;
eval {
	eval {
		eval {
			eval { throwAnError();};
			$msg = $@;
		};
	};
	if ($msg) { Triceps::nestfess("Nested error:", $msg); }
};

#print $msg;
ok($msg, qr/^A manual error at .*
	main::throwAnError\(\) called at .*
	eval \{\.\.\.\} called at .*
	eval \{\.\.\.\} called at .*
	eval \{\.\.\.\} called at .*
	eval \{\.\.\.\} called at .*
$/);

#print "$@";
ok($@, qr/^Nested error:
  A manual error at .*
	main::throwAnError\(\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# wrapfess passing through the return value on no error

my $rtres = Triceps::wrapfess "Error msg", sub {
	Triceps::RowType->new(
		@def1
	);
};
ok(ref $rtres, "Triceps::RowType");

#############################################################
# wrapfess with a constant string, and a manually thrown error

eval {
	Triceps::wrapfess "Nested error:", sub { throwAnError(); };
};
#print "$@";
ok($@, qr/^Nested error:
  A manual error at .*
	main::throwAnError\(\) called at .*
	main::__ANON__ called at .*
	Triceps::wrapfess\(.*\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# wrapfess with a reference to constant string, and a manually thrown error

eval {
	my $err = "Some error:";
	Triceps::wrapfess \$err, sub { $err = "Nested error:"; throwAnError(); };
};
#print "$@";
ok($@, qr/^Nested error:
  A manual error at .*
	main::throwAnError\(\) called at .*
	main::__ANON__ called at .*
	Triceps::wrapfess\(.*\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# wrapfess with a string generated by code, and an error from XS

eval {
	Triceps::wrapfess sub { "Nested error:" }, sub { makeBadRowType(); };
};
#print "$@";
ok($@, qr/^Nested error:
  Triceps::RowType::new: field 'a' has an unknown type 'badtype'
  Triceps::RowType::new: The specification was: \{
    a => badtype
  \} at .*
	main::makeBadRowType\(\) called at .*
	main::__ANON__ called at .*
	Triceps::wrapfess\(.*\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# wrapfess with a string generated by a reference to code, and an error from XS

eval {
	my $err = "Some error:";
	Triceps::wrapfess \$err, sub { $err = sub { "Nested error:" }; makeBadRowType(); };
};
#print "$@";
ok($@, qr/^Nested error:
  Triceps::RowType::new: field 'a' has an unknown type 'badtype'
  Triceps::RowType::new: The specification was: \{
    a => badtype
  \} at .*
	main::makeBadRowType\(\) called at .*
	main::__ANON__ called at .*
	Triceps::wrapfess\(.*\) called at .*
	eval \{\.\.\.\} called at .*
$/);

#############################################################
# nestfess/wrapfess handling the interleaved errors from a mix of Perl and XS

ok($u1->maxStackDepth(), 0);
ok($u1->maxRecursionDepth(), 1);
$u1->setMaxRecursionDepth(3);
ok($u1->maxRecursionDepth(), 3);

eval {
	Triceps::wrapfess "Wrapped the error", sub {
		$u1->call($recrop);
	};
};
#print "$@";
ok($@, qr/^Wrapped the error
  Exceeded the unit recursion depth limit 3 \(attempted 4\) on the label 'reclab'. at .*
	main::__ANON__\(.*\) called at .*
	eval \{\.\.\.\} called at .*
  Detected in the unit 'u1' label 'reclab' execution handler.
  Called through the label 'reclab'. at .*
	main::__ANON__\(.*\) called at .*
	eval \{\.\.\.\} called at .*
  Detected in the unit 'u1' label 'reclab' execution handler.
  Called through the label 'reclab'. at .*
	main::__ANON__\(.*\) called at .*
	eval \{\.\.\.\} called at .*
  Detected in the unit 'u1' label 'reclab' execution handler.
  Called through the label 'reclab'. at .*
	main::__ANON__ called at .*
	Triceps::wrapfess\(.Wrapped the error.*\) called at .*
	eval \{\.\.\.\} called at .*
$/);

# restore back to defaults
$u1->setMaxRecursionDepth(1);
