t/op/cc_state.t

   1 #! perl
   2
   3 # Copyright (C) 2006-2009, Parrot Foundation.
   4 # $Id$
   5
   6 use strict;
   7 use warnings;
   8
   9 use lib qw/. lib/;
  10 use Parrot::Test tests => 15;
  11 use Test::More;
  12
  13 ## test description key
  14 # A  args/params        R  results/returns
  15 # C: src     D: dest
  16 # I  IREG    S  SREG    P  PREG    N  NREG
  17 # m  normal  f  flat
  18 # u  unnamed n  named   r  required  o  optional
  19 # m  normal  s  slurpy  E  end
  20
  21 ## the section titles below refer to the row/column designation in the state table
  22
  23 ## A1
  24 pcc_ok( { args => "'abc'", params => ".param pmc abc" }, 'A C:Sum D:Pur' );
  25
  26 ## A2
  27 pcc_ok( { args => "'abc'",        params => ".param pmc abc :slurpy" }, 'A C:Pum D:Purs' );
  28 pcc_ok( { args => "'abc', 'def'", params => ".param pmc abc :slurpy" }, 'A C:Pum D:Purs' );
  29 pcc_ok( { args => "'123'",        params => ".param pmc abc" },         'A C:Pum D:Pur' );
  30
  31 ## A3
  32 pcc_ok( { args => "", params => "" } );
  33
  34 ## A5
  35 pcc_like(
  36     { args => "123", params => ".param pmc x :named('x')" },
  37     '/positional arg found, named arg expected/',
  38     'positional found, named expected',
  39     todo => 'cc processor state missing',
  40 );
  41
  42 ## E -- not yet working
  43 #pcc_like({args=>"x=>['123';'456'] :flat", params=>".param pmc x"},
  44 #    '/named arg found, positional param expected/',
  45 #    'E1: named found, required param expected',
  46 #);
  47
  48 #pcc_like({args=>"x=>['123';'456'] :flat", params=>".param pmc x"},
  49 #    '/named arg found, required param expected/',
  50 #    'E2: named found, required slurpy param expected',
  51 #);
  52
  53 ## G
  54 pcc_error_like(
  55     { params => ".param pmc abc" },
  56     '/too few positional arguments: 0 passed, 1 \(or more\) expected/',
  57     'G1: argument underflow: required param',
  58 );
  59
  60 pcc_like(
  61     { params => ".param pmc abc :slurpy" },
  62     '/argument underflow: required slurpy param expected/',
  63     'G2: argument underflow: required slurpy param',
  64     todo => 'failing',
  65 );
  66
  67 pcc_ok( { params => ".param pmc abc :optional" }, 'G3: optional param may be empty', );
  68
  69 pcc_ok( { params => ".param pmc abc :optional :slurpy" },
  70     'G4: optional slurpy param may be empty' );
  71
  72 pcc_error_like(
  73     { params => ".param pmc abc :named('x')" },
  74     '/too few named arguments: no argument for required parameter \'x\'/',
  75     'G5: argument underflow: named required param',
  76 );
  77
  78 pcc_error_like(
  79     { params => ".param pmc abc :named('x') :slurpy" },
  80     '/too few named arguments: no argument for required parameter \'x\'/',
  81     'G6: argument underflow: named required slurpy param',
  82 );
  83
  84 pcc_ok(
  85     { params => ".param pmc abc :named('x') :optional" },
  86     'G7: named optional param may be empty',
  87 );
  88
  89 pcc_ok(
  90     { params => ".param pmc abc :named('x') :optional :slurpy" },
  91     'G8: named optional slurpy param may be empty',
  92 );
  93
  94 pcc_ok( {}, 'G9: no args, no params' );
  95
  96 exit;
  97
  98 sub pcc_ok {
  99     my ( $o, $desc, %todo ) = @_;
 100     my $test = create(%$o);
 101     pir_output_is( $test, "ok\n", $desc, %todo )
 102         or !exists $todo{todo} && diag $test;
 103 }
 104
 105 sub pcc_like {
 106     my ( $o, $exp, $desc, %todo ) = @_;
 107     my $test = create(%$o);
 108     pir_output_like( $test, $exp, $desc, %todo )
 109         or !exists $todo{todo} && diag $test;
 110 }
 111
 112 sub pcc_error_like {
 113     my ( $o, $exp, $desc, %todo ) = @_;
 114     my $test = create(%$o);
 115     pir_error_output_like( $test, $exp, $desc, %todo )
 116         or !exists $todo{todo} && diag $test;
 117 }
 118
 119 sub create {
 120     my %o = @_;
 121     $o{$_} ||= '' for qw/args params returns results/;
 122
 123     $o{returns} =
 124         defined $o{returns}
 125         ? "($o{returns}) = "
 126         : '';
 127
 128     my $t = <<"TEST";
 129 .sub 'main' :main
 130     $o{returns} 'foo'($o{args})
 131     say 'ok'
 132 .end
 133
 134 .sub 'foo'
 135 $o{params}
 136 $o{results}
 137 .end
 138 TEST
 139
 140     #    diag($t);
 141     return $t;
 142 }
 143
 144 # Local Variables:
 145 #   mode: cperl
 146 #   cperl-indent-level: 4
 147 #   fill-column: 100
 148 # End:
 149 # vim: expandtab shiftwidth=4: