################################################################################
#
# $Project: /Devel-Tokenizer-C $
# $Author: mhx $
# $Date: 2008/12/13 16:00:41 +0100 $
# $Revision: 7 $
# $Source: /t/common.sub $
#
################################################################################
# 
# Copyright (c) 2002-2008 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
# 
################################################################################

use Config;
use IO::File;
use IPC::Open3;

sub get_key
{
  my $key = shift;
  $key =~ s/\W/_/g;
  return $key;
}

sub gencode
{
  my($dtc, $words, $prefix, $suffix) = @_;

  $prefix ||= '';
  $suffix ||= '';

  my $code = $dtc->generate;
  my $enum = join "\n", map "  KEY_".get_key($_).",", @$words;

<<ENDC;
#include <stdio.h>

#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;
  my @args = @_;

  my(@sout, @serr);
  local(*W, *S, *E);

  print "# running $prog @args\n";

  my $pid = open3(\*W, \*S, \*E, $prog, @args);

  eval {
    @sout = <S>;
    @serr = <E>;
    waitpid($pid, 0);
  };

  my %rval = (
    status => $? >> 8,
    stdout => \@sout,
    stderr => \@serr,
  );

  $rval{didnotrun} = 0;

  if( @serr && $serr[0] =~ /^Can't exec "\Q$prog\E":/ ) {
    $rval{didnotrun} = 1;
  }

  if( $^O eq 'MSWin32' && $rval{status} == 1 ) {
    $rval{didnotrun} = 1;
  }

  $? & 128 and $rval{core}   = 1;
  $? & 127 and $rval{signal} = $? & 127;
 
  \%rval;
}