The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Reporting;

use strict;
use warnings;

use Test2::Tools::Basic qw( ok );
use Test2::Tools::Class qw( can_ok isa_ok );
use Test2::Tools::Compare qw( call end field hash is object T validator );
use Test2::Tools::Subtest qw( subtest_streamed );

use Scalar::Util 'looks_like_number';

use Exporter qw( import );

our @EXPORT_OK = 'test_report';

my $PosOrZero
  = validator( 'number >= 0' => sub { looks_like_number($_) && $_ >= 0 } );

sub test_report {
    my $report = shift;
    my $expect = shift;

    is( $report->timing_data,
        _test_timing_data($expect),
        'timing data for entire report'
    );

    my @got_classes = $report->all_test_classes;
    is( [ sort map { $_->name } @got_classes ],
        [ sort keys %{ $expect->{classes} } ],
        'class reports have expected names'
    );

    for my $method (
        qw( is_parallel num_tests_run num_test_instances num_test_methods ))
    {
        is( $report->$method,
            $expect->{$method},
            $method
        );
    }

    for my $class_report (@got_classes) {
        my $class_name = $class_report->name;
        subtest_streamed(
            "report for class: $class_name" => sub {
                unless ( $expect->{classes}{$class_name} ) {
                    ok( 0, 'unexpected class in report: ' . $class_name );
                    return;
                }
                _test_class_report(
                    $class_report,
                    $expect->{classes}{$class_name},
                    $class_name->run_control_methods_on_skip,
                );
            }
        );
    }
}

sub _test_timing_data {
    my $expect = shift;

    return hash {
        _time_field();
        field class => hash {
            for my $class ( keys %{ $expect->{classes} } ) {
                field $class => _class_timing_structure(
                    $expect->{classes}{$class},
                    $class->run_control_methods_on_skip,
                );
            }
            end();
        };
        end();
    };
}

sub _class_timing_structure {
    my $expect                      = shift;
    my $always_runs_control_methods = shift;

    return hash {
        _time_field();
        if ( $expect->{instances} ) {
            field instance => hash {
                for my $instance ( keys %{ $expect->{instances} } ) {
                    field $instance => _instance_timing_structure(
                        $expect->{instances}{$instance},
                        $always_runs_control_methods,
                    );
                }
                end();
            };
        }
        end();
    };
}

sub _instance_timing_structure {
    my $expect                      = shift;
    my $always_runs_control_methods = shift;

    return hash {
        _time_field();
        field control => hash {
            field test_startup => hash {
                _time_field();
                end();
            };

            unless ( $expect->{is_skipped}->name eq 'TRUE'
                && !$always_runs_control_methods )
            {
                field test_shutdown => hash {
                    _time_field();
                    end();
                };
            }

            end();
        };

        return unless keys %{ $expect->{methods} };

        field method => hash {
            for my $method ( keys %{ $expect->{methods} } ) {
                field $method => _method_timing_structure(
                    $expect->{methods}{$method},
                    $always_runs_control_methods,
                );
            }
            end();
        };
        end();
    };
}

sub _method_timing_structure {
    my $expect                      = shift;
    my $always_runs_control_methods = shift;

    return hash {
        _time_field();
        field control => hash {
            field test_setup => hash {
                _time_field();
                end();
            };

            unless ( $expect->{is_skipped}->name eq 'TRUE'
                && !$always_runs_control_methods )
            {
                field test_teardown => hash {
                    _time_field();
                    end();
                };
            }

            end();
        };
        end();
    };
}

sub _time_field {
    return field time => hash {
        field real   => $PosOrZero;
        field system => $PosOrZero;
        field user   => $PosOrZero;
        end();
    };
}

sub _test_class_report {
    my $class_report                = shift;
    my $expect                      = shift;
    my $always_runs_control_methods = shift;

    _test_report_time($class_report);

    for my $method (qw( is_skipped passed )) {
        is( $class_report->$method,
            $expect->{$method},
            $method
        );
    }

    my @got_instances = $class_report->all_test_instances;
    is( scalar @got_instances,
        scalar keys %{ $expect->{instances} },
        'number of instances'
    );

    for my $instance_report (@got_instances) {
        my $instance_name = $instance_report->name;
        subtest_streamed(
            "report for instance: $instance_name" => sub {
                _test_instance_report(
                    $instance_report,
                    $expect->{instances}{$instance_name},
                    $always_runs_control_methods,
                );
            }
        );
    }
}

sub _test_instance_report {
    my $instance_report             = shift;
    my $expect                      = shift;
    my $always_runs_control_methods = shift;

    _test_report_time($instance_report);

    for my $method (qw( is_skipped passed )) {
        is( $instance_report->$method,
            $expect->{$method},
            $method
        );
    }

    my @control = 'test_startup';
    push @control, 'test_shutdown'
      if $always_runs_control_methods || !$instance_report->is_skipped;

    _test_control_methods(
        $instance_report,
        @control,
    );

    my @methods = $instance_report->all_test_methods;
    is( [ sort map { $_->name } @methods ],
        [ sort keys %{ $expect->{methods} } ],
        'methods'
    );

    for my $method_report (@methods) {
        my $method_name = $method_report->name;
        subtest_streamed(
            "report for method: $method_name" => sub {
                _test_method_report(
                    $method_report,
                    $expect->{methods}{$method_name},
                    $always_runs_control_methods,
                );
            }
        );
    }
}

sub _test_method_report {
    my $method_report               = shift;
    my $expect                      = shift;
    my $always_runs_control_methods = shift;

    _test_report_time($method_report);

    for my $method (qw( is_skipped passed num_tests_run tests_planned )) {
        is( $method_report->$method,
            $expect->{$method},
            $method
        );
    }

    my @control = 'test_setup';
    push @control, 'test_teardown'
      if $always_runs_control_methods || !$method_report->is_skipped;

    _test_control_methods( $method_report, @control );
}

sub _test_control_methods {
    my $report = shift;

    for my $control (@_) {
        subtest_streamed(
            "report for control method: $control" => sub {
                my $report_meth   = $control . '_method';
                my $method_report = $report->$report_meth;
                _test_report_time($method_report);
                isa_ok(
                    $method_report,
                    'Test::Class::Moose::Report::Method',
                );
                is( $method_report->name,
                    $control,
                    "$control method report name"
                );
                is( $method_report->num_tests_run,
                    0,
                    "no tests run in $control"
                );
            }
        );
    }
}

{
    my $pos
      = validator( 'number > 0', sub { looks_like_number($_) && $_ > 0 } );

    sub _test_report_time {
        my $report = shift;

        subtest_streamed(
            'timing report',
            sub {
                is( $report,
                    object {
                        call start_time => $pos;
                        call end_time   => $pos;
                    },
                    'report has start and end time'
                );

                can_ok( $report, 'time' );
                my $time = $report->time;
                isa_ok(
                    $time,
                    'Test::Class::Moose::Report::Time',
                );

                is( $time,
                    object {
                        call real   => $PosOrZero;
                        call system => $PosOrZero;
                        call user   => $PosOrZero;
                    },
                    'time object has expected values'
                );
            }
        );
    }
}

1;