t/op/01-parse_ops.t

   1 #! perl
   2 # Copyright (C) 2006-2008, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Parrot::Test;
   9 use Parrot::Op;
  10 use Parrot::OpLib::core;
  11
  12 =head1 NAME
  13
  14 t/op/01-parse_ops.t - Parse core opcodes
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/op/01-parse_ops.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests that all parrot opcodes are parsed properly.
  23
  24 =cut
  25
  26 my $object_map = {
  27     i   => q<I0>,
  28     ic  => q<42>,
  29     k   => q<P0>,
  30     kc  => q<[ 'foo' ; 'bar' ]>,
  31     kic => q<[ 1 ]>,
  32     ks  => q<P0>,
  33     ksc => q<[ 'foo' ; 'bar' ]>,
  34     n   => q<N0>,
  35     nc  => q<13.013>,
  36     p   => q<P0>,
  37     pc  => undef,                  ## RT#39992 figure out how to test this type
  38     s   => q<S0>,
  39     sc  => q<'foo'>,
  40 };
  41
  42 my %parse_errors = map { $_ => 1 } qw(
  43     defined
  44     delete
  45     eq
  46     exists
  47     le
  48     lt
  49     ne
  50     set
  51     slice
  52     typeof
  53     yield
  54 );
  55
  56 my %cmds;
  57
  58 ## extract the register types from each opcode
  59 for my $op (@$Parrot::OpLib::core::ops) {
  60     my @regtypes = $op->arg_types;
  61
  62     ## for now, avoid opcodes with regtypes i don't know how to represent
  63     next unless @regtypes == grep { defined $$object_map{$_} } @regtypes;
  64
  65     ## extract the basename of the opcode
  66     my $basename = $op->name;
  67
  68     ## create the argument list
  69     my $args = join ', ' => map $$object_map{$_}, @regtypes;
  70
  71     ## store the test commands
  72     $cmds{$basename}{ $basename . ' ' . $args }++;
  73 }
  74
  75 $ENV{TEST_PROG_ARGS} ||= '';
  76
  77 plan skip_all => 'IMCC cannot do parse-only with JIT enabled'
  78     if $ENV{TEST_PROG_ARGS} =~ /-j/;
  79
  80 plan skip_all => 'IMCC cannot do parse-only with switched core'
  81     if $ENV{TEST_PROG_ARGS} =~ /-S/;
  82
  83 plan tests => scalar keys %cmds;
  84
  85 for my $cmd ( sort keys %cmds ) {
  86     my @args = (
  87         ## retrieve the test commands, and trick IMCC to parse only
  88         join( $/ => 'end', sort( keys %{ $cmds{$cmd} } ), '' ),
  89         qr/^(?!error:imcc:syntax error,)/,
  90         "parsing: $cmd"
  91     );
  92
  93     if ( $parse_errors{$cmd} ) {
  94         pasm_error_output_like(@args);
  95     }
  96     else {
  97         pasm_output_like(@args);
  98     }
  99 }
 100
 101 # Local Variables:
 102 #   mode: cperl
 103 #   cperl-indent-level: 4
 104 #   fill-column: 100
 105 # End:
 106 # vim: expandtab shiftwidth=4: