1 | #!/usr/bin/env perl
|
2 |
|
3 | use strict;
|
4 | use warnings;
|
5 |
|
6 | use TestML;
|
7 |
|
8 | if (not $ENV{TESTML_COMPILER_BOOTSTRAP}) {
|
9 | exec("$ENV{TESTML_ROOT}/bin/testml-perl-tap", @ARGV) or die;
|
10 | }
|
11 |
|
12 | my $testml_path = $ARGV[0];
|
13 |
|
14 | open TESTML, $testml_path or
|
15 | die "Can't open '$testml_path' for input";
|
16 |
|
17 | my $testml = do {local $/; <TESTML>};
|
18 |
|
19 | close TESTML;
|
20 |
|
21 | $testml =~ s/\A\s*%TestML\s+\d.*\n+//;
|
22 |
|
23 | $testml = "%TestML 0.1.0\n\n$testml";
|
24 |
|
25 | {
|
26 | package Bridge;
|
27 | use base 'TestML::Bridge';
|
28 | use TestML::Util;
|
29 | use File::Temp qw/tempdir/;
|
30 | use Capture::Tiny 'capture';
|
31 | use Test::More;
|
32 |
|
33 | sub undent {
|
34 | my ($self, $text) = @_;
|
35 | $text = $text->value;
|
36 | $text =~ s/^ //mg;
|
37 | return str $text;
|
38 | }
|
39 |
|
40 | sub compile {
|
41 | my ($self, $testml, $import) = @_;
|
42 | $testml = $testml->value;
|
43 | $import = $import ? $import->value : undef;
|
44 | $import = $self->parse_import($import);
|
45 |
|
46 | my ($temp_dir) = tempdir or die;
|
47 | my $temp_file = "$temp_dir/test.tml";
|
48 | open my $temp_handle, '>', $temp_file
|
49 | or die "Can't open '$temp_file' for output: $!";
|
50 | print $temp_handle $testml;
|
51 | close $temp_handle;
|
52 |
|
53 | for my $file (keys %$import) {
|
54 | my $temp_file = "$temp_dir/$file";
|
55 | open my $temp_handle, '>', $temp_file
|
56 | or die "Can't open '$temp_file' for output: $!";
|
57 | print $temp_handle $import->{$file};
|
58 | close $temp_handle;
|
59 | }
|
60 |
|
61 | my ($stdout, $stderr, $rc) = capture {
|
62 | system("testml-compiler $temp_file");
|
63 | };
|
64 |
|
65 | die "Error while testing testml-compiler:\n$stderr"
|
66 | if $rc != 0;
|
67 |
|
68 | warn $stderr if $stderr;
|
69 |
|
70 | return str $stdout;
|
71 | }
|
72 |
|
73 | sub parse_import {
|
74 | my ($self, $import) = @_;
|
75 |
|
76 | return {} unless $import;
|
77 |
|
78 | my @import = split /^\+\+\+\ (.*)\n/m, $import;
|
79 | shift @import;
|
80 |
|
81 | return {@import};
|
82 | }
|
83 | }
|
84 |
|
85 | TestML->new(
|
86 | testml => $testml,
|
87 | bridge => 'Bridge',
|
88 | )->run;
|
89 |
|
90 | # vim: sw=2:
|