1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
|
#!/usr/bin/perl
use v5.18;
use warnings;
use Test2::V0 0.000148; # is_refcount
use Object::Pad 0.800;
use constant HAVE_DATA_DUMP => defined eval { require Data::Dump; };
class Counter {
field $count = 0;
method inc { $count++ }
method count { return $count; }
}
{
my $counter = Counter->new;
is( $counter->count, 0, 'Count initially 0' );
$counter->inc;
$counter->inc;
$counter->inc;
is( $counter->count, 3, 'Count is now 3 after ->inc x 3' );
}
{
use Data::Dumper;
class AllTheTypes {
field $scalar = 123;
field @array = ( 45, 67 );
field %hash = ( 89 => 10 );
method test {
::is( $scalar, 123, '$scalar field' );
::is( \@array, [ 45, 67 ], '@array field' );
::is( \%hash, { 89 => 10 }, '%hash field' );
}
}
my $instance = AllTheTypes->new;
$instance->test;
# The exact output of this test is fragile as it depends on the internal
# representation of the instance, which we do not document and is not part
# of the API guarantee. We're not really checking that it has exactly this
# output, just that Data::Dumper itself doesn't crash. If a later version
# changes the representation so that the output here differs, just change
# the test as long as it is something sensible.
is( Dumper($instance) =~ s/\s+//gr,
q($VAR1=bless([123,[45,67],{'89'=>10}],'AllTheTypes');),
'Dumper($instance) sees field data' );
HAVE_DATA_DUMP and is( Data::Dump::pp($instance),
q(bless([123, [45, 67], { 89 => 10 }], "AllTheTypes")),
'pp($instance) sees field data' );
}
{
use Object::Pad ':experimental(init_expr)';
my $class_in_fieldblock;
class AllTheTypesByBlock {
field $scalar { "one" }
field @array { "two", "three" }
field %hash { four => "five" }
field $__dummy { $class_in_fieldblock = __CLASS__ }
method test {
::is( $scalar, "one", '$scalar field' );
::is( \@array, [qw( two three )], '@array field' );
::is( \%hash, { four => "five" }, '%hash field' );
}
}
AllTheTypesByBlock->new->test;
is( $class_in_fieldblock, "AllTheTypesByBlock" );
}
# Variant of RT132228 about individual field lexicals
class Holder {
field $field;
method field :lvalue { $field }
}
{
my $datum = [];
is_oneref( $datum, '$datum initially' );
my $holder = Holder->new;
$holder->field = $datum;
is_refcount( $datum, 2, '$datum while held by Holder' );
undef $holder;
is_oneref( $datum, '$datum finally' );
}
# Fields are visible to string-eval()
{
class Evil {
field $field;
method test {
$field = "the value";
::is( eval '$field', "the value", 'fields are visible to string eval()' );
}
}
Evil->new->test;
}
{
class FieldWithListExpr {
field @array = ( 0 ) x 5;
}
pass( 'Code compiles with listexpr as field initialiser' );
}
ok( !eval <<'EOPERL',
class SelfInField {
field $x = $self + 1;
}
EOPERL
'field init expression cannot see $self' );
# TODO: Annoyingly, real parse error message has disappeared entirely from $@
# and all we get is "parse failed--compilation aborted at ..." so there's no
# point like()-testing $@ here
# RT154639 - fields should not be visible to :common methods
my $e = eval <<'EOPERL' ? undef : $@;
class FieldInCommonMethod {
field $x;
method m :common { $x }
}
EOPERL
like( $e, qr/^Global symbol "\$x" requires explicit package name /,
'fields are not visible to :common methods' );
done_testing;
|