← Back to branch summary

~ubuntu-branches/debian/sid/libuniversal-ref-perl/sid

« back to all changes in this revision

Viewing changes to t/basic.t

  • Committer: Package Import Robot
  • Author(s): Jonas Smedegaard
  • Date: 2015-02-24 22:56:47 UTC
  • Revision ID: package-import@ubuntu.com-20150224225647-oae4wnyoolc336m5
Tags: upstream-0.14
Import upstream version 0.14

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/basic.t
 
1
#!perl
 
2
use strict;
 
3
use warnings;
 
4
use Test::More;
 
5
our $TESTS;
 
6
 
 
7
# # ok( not( defined undef ), 'undef is undefined' );
 
8
# # ok( defined 1,            '1 is defined' );
 
9
# # ok( defined '...',        '"..." is defined' );
 
10
# # ok( defined [], '[] is defined' );
 
11
# #
 
12
# # sub X1::defined {1}
 
13
# # sub X2::defined {0}
 
14
# # ok( defined( bless [], 'X1' ), 'X1 is defined because ->defined is true' );
 
15
# # ok( not( defined bless [], 'X2' ),
 
16
# #     'X2 is not defined because ->defined is false' );
 
17
# #
 
18
# # sub Y::defined { }
 
19
# # ok( not( defined bless [], 'Y' ),
 
20
# #     'Y is not defined because ->defined returned empty' );
 
21
# #
 
22
# # sub Z::defined { return ( 0, 0 ) }
 
23
# # ok( not( defined bless [], 'Z' ), q[Z returned (0,0) so it is undefined] );
 
24
# #
 
25
# # ok( defined( bless [], 'A' ), 'A has no ->defined method so it is fine' );
 
26
#
 
27
 
 
28
TODO: {
 
29
 
 
30
    # This test must occur before UNIVERSAL::ref is compiled.
 
31
    BEGIN { $TESTS += 1 }
 
32
    local $TODO = q[Impossible using current technology.];
 
33
 
 
34
    # Fixing this requires peeking at the optrees being used by yylex
 
35
    # that haven't been fed to newATTRSUB yet. Is there some ultra
 
36
    # sneaky way to get access to these ops uh... without going
 
37
    # through a CV's ROOT?
 
38
 
 
39
    package main;
 
40
    is( ref( bless [], 'PAST' ), 'lie', 'I even fix the past' );
 
41
 
 
42
    package PAST;
 
43
    use UNIVERSAL::ref;
 
44
    sub ref {'lie'}
 
45
 
 
46
}
 
47
 
 
48
{
 
49
    BEGIN { $TESTS += 1 }
 
50
 
 
51
    package LIAR;
 
52
    use UNIVERSAL::ref;
 
53
    sub ref {'lie'}
 
54
 
 
55
    package main;
 
56
 
 
57
    # Validate that ref() lies for us.
 
58
    is( CORE::ref( bless [], 'LIAR' ), 'lie', 'Lying 101' );
 
59
}
 
60
 
 
61
SKIP: {
 
62
    BEGIN { $TESTS += 1 }
 
63
 
 
64
    eval q[use Data::Dumper 'Dumper'];
 
65
    skip( q[Don't have Data::Dumper], 1 )
 
66
        if not defined &Dumper;
 
67
 
 
68
    like( Dumper( bless [], 'LIAR' ), qr/LIAR/,
 
69
        'Data::Dumper is unpeturbed' );
 
70
}
 
71
 
 
72
SKIP: {
 
73
    BEGIN { $TESTS += 1 }
 
74
 
 
75
    eval q[use Data::Dump::Streamer 'Dump'];
 
76
    skip( q[Don't have Data::Dump::Streamer], 1 )
 
77
        if not defined &Dump;
 
78
 
 
79
    like( Dump( bless [], 'LIAR' )->Out,
 
80
        qr/LIAR/, 'Data::Dump::Streamer is ok' );
 
81
}
 
82
 
 
83
{
 
84
    BEGIN { $TESTS += 3 }
 
85
 
 
86
    # Validate that ref() works as normal for non-hooked things.
 
87
    is( ref(''), '', 'Ordinary things are ordinary 1' );
 
88
    is( ref( [] ), 'ARRAY', 'Ordinary things are ordinary 2' );
 
89
    is( ref( bless [], 'A1' ), 'A1', 'Ordinary things are ordinary 3' );
 
90
}
 
91
 
 
92
{
 
93
    BEGIN { $TESTS += 2 }
 
94
 
 
95
    package DELUSION;
 
96
    use UNIVERSAL::ref;
 
97
    sub ref    {'blah blah blah'}
 
98
    sub myself { CORE::ref $_[0] }
 
99
 
 
100
    package main;
 
101
    is( ref( bless( [], 'DELUSION' ) ), 'blah blah blah', 'Self delusion 1' );
 
102
    is( bless( [], 'DELUSION' )->myself, 'DELUSION', 'Self delusion 2' );
 
103
}
 
104
 
 
105
{
 
106
    BEGIN { $TESTS += 2 }
 
107
 
 
108
    package OVERLOADED;
 
109
    sub ref { warn; 'NOT-OVERLOADED' }
 
110
    use overload 'bool' => sub () {'FALSE'};
 
111
    use UNIVERSAL::ref;
 
112
 
 
113
    package main;
 
114
    my $obj = bless [], 'OVERLOADED';
 
115
    ok( overload::Overloaded($obj),
 
116
        'Overloaded objects still look overloaded' );
 
117
    like(
 
118
        overload::StrVal($obj),
 
119
        qr/\A\QOVERLOADED=ARRAY(0x\E[\da-fA-F]+\)\z/,
 
120
        'Overloaded objects stringify normally too'
 
121
    );
 
122
}
 
123
 
 
124
BEGIN { plan('no_plan') }