t/21-tie.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 {
   7  package Lexical::Types::Test::Str;
   8
   9  sub TIESCALAR {
  10   my ($class, $buf) = @_;
  11   $class = ref($class) || $class;
  12   unless (defined $buf) {
  13    $buf = '';
  14   } elsif ($buf->isa($class)) {
  15    $buf = $buf->{buffer};
  16   }
  17   bless { buffer => $buf }, $class;
  18  }
  19
  20  sub FETCH { shift->{buffer} }
  21
  22  sub STORE {
  23   my ($self, $val) = @_;
  24   $self->{buffer} = (ref($val) && $val->isa(ref($self))) ? $val->{buffer}
  25                                                          : $val;
  26  }
  27
  28  sub TYPEDSCALAR { tie $_[1], __PACKAGE__; () }
  29 }
  30
  31 { package Str; }
  32
  33 use Test::More tests => 2 * 6;
  34
  35 use Lexical::Types as => 'Lexical::Types::Test';
  36
  37 for (1 .. 2) {
  38  my Str $x = "abc";
  39
  40  is ref(tied($x)), 'Lexical::Types::Test::Str', '$x';
  41  is "$x",          'abc',                       '$x contains the right thing';
  42
  43  $x .= "foo";
  44  is ref(tied($x)), 'Lexical::Types::Test::Str', '$x . "foo"';
  45  is "$x",          'abcfoo',                    '$x . "foo" contains the right thing';
  46
  47  my Str $y = "bar" . $x;
  48
  49  is ref(tied($y)), 'Lexical::Types::Test::Str', '$y';
  50  is "$y",          'barabcfoo',                 '$y contains the right thing';
  51 }