File: 02fields.t

package info (click to toggle)
libobject-pad-perl 0.821-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 936 kB
  • sloc: ansic: 3,361; perl: 3,328; pascal: 28; makefile: 3
file content (146 lines) | stat: -rw-r--r-- 3,587 bytes parent folder | download | duplicates (2)
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;