t/11-args.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 14 + 6;
   7
   8 {
   9  package Lexical::Types::Test::LTT;
  10
  11  sub TYPEDSCALAR {
  12   $_[1] = (caller(0))[2];
  13   local $Test::Builder::Level = $Test::Builder::Level + 1;
  14   Test::More::is($_[2], 'LTT', 'original type is ok');
  15   ();
  16  }
  17
  18  no warnings 'once';
  19  *TS = \&TYPEDSCALAR;
  20 }
  21
  22 {
  23  package Lexical::Types::Test::LTT2;
  24
  25  sub TYPEDSCALAR { 1 .. 2 }
  26 }
  27
  28 {
  29  package Lexical::Types::Test::LTT3;
  30
  31  sub TYPEDSCALAR { die 'coconut' }
  32 }
  33
  34 {
  35  package LTT;
  36
  37  no warnings 'once';
  38  *ts = \&Lexical::Types::Test::LTT::TYPEDSCALAR
  39 }
  40
  41 {
  42  use Lexical::Types as => 'Lexical::Types::Test';
  43  my LTT $x;
  44  is $x, __LINE__-1, 'as => string, without trailing ::';
  45
  46  no Lexical::Types;
  47  my LTT $y;
  48  is $y, undef, 'after no';
  49 }
  50
  51 {
  52  use Lexical::Types as => 'Lexical::Types::Test::';
  53  my LTT $x;
  54  is $x, __LINE__-1, 'as => string, with trailing ::';
  55 }
  56
  57 {
  58  use Lexical::Types as => sub { return };
  59  my LTT $x;
  60  is $x, undef, 'as => code, returning nothing';
  61 }
  62
  63 {
  64  use Lexical::Types as => sub { 'Lexical::Types::Test::LTT' };
  65  my LTT $x;
  66  is $x, __LINE__-1, 'as => code, returning package name';
  67 }
  68
  69 {
  70  use Lexical::Types as => sub { 'Lexical::Types::Test::LTT', undef };
  71  my LTT $x;
  72  is $x, __LINE__-1, 'as => code, returning package name and undef';
  73 }
  74
  75 {
  76  use Lexical::Types as => sub { undef, 'ts' };
  77  my LTT $x;
  78  is $x, __LINE__-1, 'as => code, returning undef and method name';
  79 }
  80
  81 {
  82  use Lexical::Types as => sub { 'Lexical::Types::Test::LTT', 'TS' };
  83  my LTT $x;
  84  is $x, __LINE__-1, 'as => code, returning package and method name';
  85 }
  86
  87 {
  88  my $expect = qr/^Invalid ARRAY reference/;
  89  local $@;
  90  eval q[
  91   use Lexical::Types as => [ qw<a b c> ];
  92   my LTT $x;
  93  ];
  94  like $@, $expect, 'as => array';
  95 }
  96
  97 {
  98  my $expect = qr/^Lexical::Types mangler should return zero, one or two scalars, but got 3/;
  99  diag 'This will throw two warnings' if $] >= 5.008008 and $] < 5.009;
 100  local $@;
 101  eval q[
 102   use Lexical::Types as => sub { qw<a b c> };
 103   my LTT $x;
 104  ];
 105  like $@, $expect, 'as => code, returning three scalars';
 106 }
 107
 108 {
 109  my $expect = qr/^Typed scalar initializer method should return zero or one scalar, but got 2/;
 110  local $@;
 111  eval q[
 112   use Lexical::Types as => sub { 'Lexical::Types::Test::LTT2' };
 113   my LTT $x;
 114  ];
 115  like $@, $expect, 'as => code, initializing by returning two scalars';
 116 }
 117
 118 {
 119  my $expect = qr/^banana at \(eval \d+\) line 2/;
 120  diag 'This will throw two more warnings' if $] >= 5.008008 and $] < 5.009;
 121  local $@;
 122  eval q[
 123   use Lexical::Types as => sub { die 'banana' };
 124   my LTT $x;
 125  ];
 126  like $@, $expect, 'as => sub { die }';
 127 }
 128
 129 {
 130  my $expect = qr/^coconut at \Q$0\E line 31/;
 131  local $@;
 132  eval q[
 133   use Lexical::Types;
 134   my Lexical::Types::Test::LTT3 $x;
 135  ];
 136  like $@, $expect, 'die in TYPEDSCALAR';
 137 }
 138
 139 my LTT $x;
 140 is $x, undef, 'out of scope';