t/foreign/signatures/proto.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 7;
   5
   6 use vars qw/@warnings/;
   7 BEGIN { $SIG{__WARN__} = sub { push @warnings, @_ } }
   8
   9 BEGIN { is(@warnings, 0, 'no warnings yet') }
  10
  11 use Function::Parameters;
  12
  13 fun with_proto ($x, $y, $z) : ($$$) {
  14     return $x + $y + $z;
  15 }
  16
  17 {
  18     my $foo;
  19     fun with_lvalue () : () lvalue { $foo }
  20 }
  21
  22 is(prototype('with_proto'), '$$$', ':proto attribute');
  23
  24 is(prototype('with_lvalue'), '', ':proto with other attributes');
  25 with_lvalue = 1;
  26 is(with_lvalue, 1, 'other attributes still there');
  27
  28 BEGIN { is(@warnings, 0, 'no warnings with correct :proto declarations') }
  29
  30 fun invalid_proto ($x) : (invalid) { $x }
  31
  32 BEGIN {
  33     #TODO: {
  34     #    local $TODO = ':proto checks not yet implemented';
  35         is(@warnings, 1, 'warning with illegal :proto');
  36         like(
  37             $warnings[0],
  38             qr/Illegal character in prototype for fun invalid_proto : invalid at /,
  39             'warning looks sane',
  40         );
  41     #}
  42 }
  43
  44 #eval 'sub foo ($bar) : proto { $bar }';
  45 #like($@, qr/proto attribute requires argument/);