The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More tests => 2;
use Test::Fatal qw(exception);

use UR;

# This is a regression test to reveal that changes were being recorded in the
# wrong order under certain conditions.  The observer causes the creation of a
# Part via 'first_part_name' to trigger the Machine object to have a property
# change on 'part_count'.  Since the change of 'part_count' would get logged
# before the 'create' of the Machine when the transaction rolled back the undo
# for the 'part_count' change would crash due to running after the 'create' was
# undone.

setup();

Part->add_observer(
    aspect => 'create',
    callback => sub {
        my ($object, $aspect) = @_;
        my $machine = $object->machine;
        my $count = $machine->part_count || 0;
        $machine->part_count($count + 1);
    },
);

my $tx = UR::Context::Transaction->begin();
my $m = Machine->create(first_part_name => 'King');

my @changes = $tx->get_changes;
my $machine_create_change = (grep { $_->changed_class_name eq 'Machine' && $_->changed_aspect eq 'create' } @changes)[0];
my $part_create_change = (grep { $_->changed_class_name eq 'Part' && $_->changed_aspect eq 'create' } @changes)[0];
ok($machine_create_change->id < $part_create_change->id, 'machine should be created before part');

ok(!exception { $tx->rollback }, 'rollback should not throw an exception');

sub setup {
    my $machine_class = UR::Object::Type->define(
        class_name => 'Machine',
        id_generator => '-uuid',
        id_by => [
            serial => { is => 'Text' },
        ],
        has => [
            part_count => { is => 'Number' },
            first_part_name => {
                is => 'Part',
                via => 'parts',
                to => 'name',
                where => [ 'serial' => 1 ],
                is_delegated => 1,
                is_mutable => 1,
            },
            parts => {
                is => 'Part',
                is_many => 1,
                reverse_as => 'machine',
            },
        ],
    );

    my $part_class = UR::Object::Type->define(
        class_name => 'Part',
        id_generator => '-uuid',
        id_by => [
            machine => {
                is => 'Machine',
                id_by => 'machine_serial',
            },
            serial => { is => 'Text' },
        ],
        has => [
            name => { is => 'Text' },
        ],
    );
}