The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;

use above 'UR';
use Test::More tests => 2;
use Test::Exception;

subtest 'duplicate/synonym key error' => sub {
    plan tests => 1;

    class BaseError {
        is => 'UR::Object',
        subclass_description_preprocessor => 'BaseError::_preprocess',
        subclassify_by => 'subclass_name',
    };

    sub BaseError::_preprocess {
        my ($class, $desc) = @_;
        my $count_prop = $desc->{has}{count};
        $desc->{has}{extra_property} = {
            is => 'Number',
            data_type => 'Number',
            property_name => 'extra_property',
            class_name => $count_prop->{class_name},
        };
        return $desc;
    }

    throws_ok { class DerivedError {
                    is => 'BaseError',
                    has => [
                        count => {
                            is => 'Number',
                        },
                    ],
                } }
        qr/synonyms for data_type/,
        'Exception when preprocessing introduces a synonym key error';
};

subtest 'preprocessor is called after attribute normalization' => sub {
    plan tests => 3;

    class AttrNormBase {
        subclass_description_preprocessor => 'AttrNormBase::_preprocess',
    };

    sub AttrNormBase::_preprocess {
        my($class, $desc) = @_;
        is($class, 'AttrNormBase', '$class arg to preprocessor');
        is($desc->{has}->{the_attr}->{data_type}, 'SomeTestType', 'Attribute "data_type" comes from "is" in class definition');
        return $desc;
    }

    ok(UR::Object::Type->define(
            class_name => 'AttrNormChild',
            is => 'AttrNormBase',
            has => [
                the_attr => { is => 'SomeTestType' },
            ],
        ),
        'Define class');
};