The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use strict;
use warnings;
use Test::More;
our $TESTS;

# # ok( not( defined undef ), 'undef is undefined' );
# # ok( defined 1,            '1 is defined' );
# # ok( defined '...',        '"..." is defined' );
# # ok( defined [], '[] is defined' );
# #
# # sub X1::defined {1}
# # sub X2::defined {0}
# # ok( defined( bless [], 'X1' ), 'X1 is defined because ->defined is true' );
# # ok( not( defined bless [], 'X2' ),
# #     'X2 is not defined because ->defined is false' );
# #
# # sub Y::defined { }
# # ok( not( defined bless [], 'Y' ),
# #     'Y is not defined because ->defined returned empty' );
# #
# # sub Z::defined { return ( 0, 0 ) }
# # ok( not( defined bless [], 'Z' ), q[Z returned (0,0) so it is undefined] );
# #
# # ok( defined( bless [], 'A' ), 'A has no ->defined method so it is fine' );
#

TODO: {

    # This test must occur before UNIVERSAL::ref is compiled.
    BEGIN { $TESTS += 1 }
    local $TODO = q[Impossible using current technology.];

    # Fixing this requires peeking at the optrees being used by yylex
    # that haven't been fed to newATTRSUB yet. Is there some ultra
    # sneaky way to get access to these ops uh... without going
    # through a CV's ROOT?

    package main;
    is( ref( bless [], 'PAST' ), 'lie', 'I even fix the past' );

    package PAST;
    use UNIVERSAL::ref;
    sub ref {'lie'}

}

{
    BEGIN { $TESTS += 1 }

    package LIAR;
    use UNIVERSAL::ref;
    sub ref {'lie'}

    package main;

    # Validate that ref() lies for us.
    is( CORE::ref( bless [], 'LIAR' ), 'lie', 'Lying 101' );
}

SKIP: {
    BEGIN { $TESTS += 1 }

    eval q[use Data::Dumper 'Dumper'];
    skip( q[Don't have Data::Dumper], 1 )
        if not defined &Dumper;

    like( Dumper( bless [], 'LIAR' ), qr/LIAR/,
        'Data::Dumper is unpeturbed' );
}

SKIP: {
    BEGIN { $TESTS += 1 }

    eval q[use Data::Dump::Streamer 'Dump'];
    skip( q[Don't have Data::Dump::Streamer], 1 )
        if not defined &Dump;

    like( Dump( bless [], 'LIAR' )->Out,
        qr/LIAR/, 'Data::Dump::Streamer is ok' );
}

{
    BEGIN { $TESTS += 3 }

    # Validate that ref() works as normal for non-hooked things.
    is( ref(''), '', 'Ordinary things are ordinary 1' );
    is( ref( [] ), 'ARRAY', 'Ordinary things are ordinary 2' );
    is( ref( bless [], 'A1' ), 'A1', 'Ordinary things are ordinary 3' );
}

{
    BEGIN { $TESTS += 2 }

    package DELUSION;
    use UNIVERSAL::ref;
    sub ref    {'blah blah blah'}
    sub myself { CORE::ref $_[0] }

    package main;
    is( ref( bless( [], 'DELUSION' ) ), 'blah blah blah', 'Self delusion 1' );
    is( bless( [], 'DELUSION' )->myself, 'DELUSION', 'Self delusion 2' );
}

{
    BEGIN { $TESTS += 2 }

    package OVERLOADED;
    sub ref { warn; 'NOT-OVERLOADED' }
    use overload 'bool' => sub () {'FALSE'};
    use UNIVERSAL::ref;

    package main;
    my $obj = bless [], 'OVERLOADED';
    ok( overload::Overloaded($obj),
        'Overloaded objects still look overloaded' );
    like(
        overload::StrVal($obj),
        qr/\A\QOVERLOADED=ARRAY(0x\E[\da-fA-F]+\)\z/,
        'Overloaded objects stringify normally too'
    );
}

BEGIN { plan('no_plan') }