The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More;
use File::Spec;
use XS::TCC qw(:all);

my $data_dir = -d 't' ? File::Spec->catdir(qw(t data)) : 'data';

tcc_inline <<HERE;
HERE

pass("Alive");

tcc_inline
  typemap => ExtUtils::Typemaps->new,
  q{
  };

pass("Alive after compilation");

################################################################################

tcc_inline
  #warn_code => 1,
  q{
    int foo(int bar) {
      return bar * 2;
    }
  };

pass("Alive after compilation");

is(main::foo(3), 6, "Simple function is callable");

pass("Alive");

################################################################################

tcc_inline
  #warn_code => 1,
  q{
    AV *
    pairwise_sum (AV *left, AV *right)
    {
      size_t i;
      SV **elem;
      double val = 0;
      const size_t len_left  = av_len(left)+1;
      const size_t len_right = av_len(right)+1;
      const size_t len = len_left < len_right ? len_left : len_right;
      AV *retval = newAV();
      sv_2mortal((SV *)retval);
      av_extend(retval, len-1);
      for (i = 0; i < len; ++i) {
        val = 0;
        elem = av_fetch(left, i, 0);
        if (elem != NULL)
          val += SvNV(*elem);
        elem = av_fetch(right, i, 0);
        if (elem != NULL)
          val += SvNV(*elem);
        av_store(retval, i, newSVnv(val));
      }
      return retval;
    }
    int foo2(int bar) {
      return bar * 2;
    }
  };

pass("Alive after compilation");

is(foo2(2), 4, "Simple function wrapped as part of multi-function wrapper");

pass("Alive");

is_deeply(pairwise_sum([1..10], [1..9]), [map $_*2, 1..9], "pairwise sum wrapped ok");

pass("Alive");

################################################################################

tcc_inline
  #warn_code => 1,
  q{
    SV *
    foo3(pTHX_ SV *sv)
    {
      return sv_2mortal(newSViv(SvIV(sv)+1));
    }
  };

pass("Alive after compilation");

is(foo3(5), 6, "simple function with pTHX works");

pass("Alive");

################################################################################

tcc_inline
  add_files => File::Spec->catfile($data_dir, 'inctest.c'),
  q{
    int wrapper(int input) {
      return mydbl(input);
    }
  };

pass("Alive after compilation (add_file inctest.c)");

is(wrapper(5), 10, "add_files works for C file");

pass("Alive");

################################################################################

tcc_inline
  #warn_code => 1,
  q{
  /* efficient */
  int which_context(pTHX) {
    return (int)GIMME_V;
  }

  /* less efficient */
  int which_context_slow() {
    dTHX;
    return (int)GIMME_V;
  }
  };

pass("Alive after compilation");

SCOPE: {
  my $s = main::which_context();
  ok(defined($s), "pTHX works");

  $s = main::which_context_slow();
  ok(defined($s), "dTHX works (testing code from docs)");
}

pass("Alive");

################################################################################

tcc_inline
  #warn_code => 1,
  q{
    int get_underbar_sum(pTHX_ int bar) {
      dUNDERBAR;
      return (int)SvIV(UNDERBAR) + bar;
    }
  };

pass("Alive after compilation");

SCOPE: {
  local $_ = 42;
  is(main::get_underbar_sum(12), 42+12, "pTHX_ works");
}

pass("Alive");

################################################################################

done_testing();