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