Devel-Tokenizer-C

 view release on metacpan or  search on metacpan

t/common.sub  view on Meta::CPAN


#define TOKEN_END '\\0'

typedef enum {
$enum
  KEY_UNKNOWN
} Keyword;

Keyword tokenize( const char *tokstr )
{
$prefix
$code
$suffix
}

int main( int argc, char **argv )
{
  FILE *in;
  char *c, buffer[256];
  Keyword key;

  in = fopen( argv[1], "r" );

  while( fgets(buffer, 256, in) ) {
    for( c=buffer; *c; c++ ) {
      if( *c == '\\n' || *c == '\\r' ) {
        *c = '\\0';
        break;
      }
    }
    key = tokenize(buffer);
    printf("\\"\%s\\" => \%d\\n", buffer, key);
  }

  fclose( in );

  return 0;
}
ENDC
}

sub runtest
{
  my $skip = shift;
  my $src  = shift;
  my $in   = shift;

  my %opt = (
    'unlink'  => !exists($ENV{UNLINK}) || $ENV{UNLINK},
    'ccflags' => [],
    @_
  );

  for( $src, $in ) {
    if( 'ARRAY' eq ref ) {
      $_ = join( "\n", @$_ ) . "\n";
    }
  }

  my $file   = './dtcrun.c';
  my $infile = './dtcdata';
  my $exe    = "./dtcrun";
  $^O eq 'MSWin32' and $exe .= '.exe';

  IO::File->new(">$file")->print($src);

  print "# compiling $file into $exe\n";
  my $r = runprog( $Config{cc}, split(' ', $Config{ccflags}), @{$opt{ccflags}}, '-o', $exe, $file );

  skip( $skip, $r->{didnotrun}, 0, "$Config{cc} did not run" );
  skip( $skip, $r->{status}, 0, "$Config{cc} did not return status 0" );

  IO::File->new(">$infile")->print($in);

  $r = runprog( $exe, $infile );

  skip( $skip, $r->{didnotrun}, 0, "$exe did not run" );
  skip( $skip, $r->{status}, 0, "$exe did not return status 0" );

  $opt{'unlink'} and unlink $file, $infile, $exe;

  return($r->{stdout}, $r->{stderr});
}

sub can_compile
{
  my $file = 'dtctest.c';
  my $exe  = "./dtctest";
  $^O eq 'MSWin32' and $exe .= '.exe';

  IO::File->new(">$file")->print( <<ENDC );
#include <stdio.h>
int main( void )
{
  printf("Hello\\n");
  return 0;
}
ENDC

  my $r = runprog( $Config{cc}, split(' ', $Config{ccflags}), '-o', $exe, $file );

  $r->{didnotrun} == 0 &&
  $r->{status}    == 0    or return 0;

  $r = runprog( $exe );

  unlink $file, $exe;

  $r->{didnotrun} == 0 &&
  $r->{status}    == 0    or return 0;

  for( @{$r->{stdout}} ) {
    /^Hello$/ and return 1;
  }

  return 0;
}

sub runprog
{
  my $prog = shift;



( run in 1.987 second using v1.01-cache-2.11-cpan-5837b0d9d2c )