testml-compiler/bin/testml-boot

#!/usr/bin/env perl

use strict;
use warnings;

use TestML;

my $testml_path = $ARGV[0];

open TESTML, $testml_path or
  die "Can't open '$testml_path' for input";

my $testml = do {local $/; <TESTML>};

close TESTML;

$testml =~ s/\A\s*%TestML\s+\d.*\n+//;

$testml = "%TestML 0.1.0\n\n$testml";

{
  package Bridge;
  use base 'TestML::Bridge';
  use TestML::Util;
  use File::Temp qw/tempdir/;
  use Capture::Tiny 'capture';
  use Test::More;
  use XXX;

  sub undent {
    my ($self, $text) = @_;
    $text = $text->value;
    $text =~ s/^    //mg;
    return str $text;
  }

  sub compile {
    my ($self, $testml, $import) = @_;
    $testml = $testml->value;
    $import = $import ? $import->value : undef;
    $import = $self->parse_import($import);

    my ($temp_dir) = tempdir or die;
    my $temp_file = "$temp_dir/test.tml";
    open my $temp_handle, '>', $temp_file
      or die "Can't open '$temp_file' for output: $!";
    print $temp_handle $testml;
    close $temp_handle;

    for my $file (keys %$import) {
      my $temp_file = "$temp_dir/$file";
      open my $temp_handle, '>', $temp_file
        or die "Can't open '$temp_file' for output: $!";
      print $temp_handle $import->{$file};
      close $temp_handle;
    }

    my ($stdout, $stderr, $rc) = capture {
      system("testml-compiler $temp_file");
    };

    die "Error while testing testml-compiler:\n$stderr"
      if $rc != 0;

    warn $stderr if $stderr;

    return str $stdout;
  }

  sub parse_import {
    my ($self, $import) = @_;

    return {} unless $import;

    my @import = split /^\+\+\+\ (.*)\n/m, $import;
    shift @import;

    return {@import};
  }
}

TestML->new(
  testml => $testml,
  bridge => 'Bridge',
)->run;