t/14-ro.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4;
   7
   8 sub Str::TYPEDSCALAR { }
   9
  10 sub Str1::TYPEDSCALAR {
  11  $_[0] = 'dongs';
  12  ();
  13 }
  14
  15 sub Str2::TYPEDSCALAR {
  16  $_[2] = 'hlagh';
  17  ();
  18 }
  19
  20 sub ro_re {
  21  my ($file, $line) = map quotemeta, @_;
  22  $file = '\\(eval \\d+\\)' unless $file;
  23  return qr/^Modification of a read-only value attempted at $file line $line/;
  24 }
  25
  26 sub maybe_warn {
  27  diag 'This will throw two warnings' if $] >= 5.008008 and $] < 5.009;
  28 }
  29
  30 {
  31  maybe_warn();
  32  local $@;
  33  eval q!
  34   use Lexical::Types as => sub { $_[0] = 'dongs'; () };
  35   my Str $x;
  36  !;
  37  like $@, ro_re('', 2), '$_[0] in initializer is read only';
  38 }
  39
  40 SKIP: {
  41  skip 'Kinda broken on old 5.8.x' => 1 if $] <= 5.008006;
  42  maybe_warn();
  43  local $@;
  44  eval q!
  45   use Lexical::Types as => sub { $_[1] = 'hlagh'; () };
  46   my Str $x;
  47  !;
  48  like $@, ro_re('', 2), '$_[1] in initializer is read only';
  49 }
  50
  51 {
  52  local $@;
  53  eval q[
  54   use Lexical::Types;
  55   my Str1 $x;
  56  ];
  57  like $@, ro_re($0, 11), '$_[0] in initializer is read only';
  58 }
  59
  60 {
  61  local $@;
  62  eval q[
  63   use Lexical::Types;
  64   my Str2 $x;
  65  ];
  66  like $@, ro_re($0, 16), '$_[2] in initializer is read only';
  67 }