t/examples/pod.t

   1 #! perl
   2 # Copyright (C) 2009-2010, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use File::Temp qw(tempfile);
  10 use Test::More qw(no_plan);
  11
  12 use Parrot::Test;
  13 use Parrot::Test::Pod;
  14 use Parrot::Config qw(%PConfig);
  15
  16 my @files = @ARGV;
  17
  18 if (!@files) {
  19   my $podTester = Parrot::Test::Pod->new( {
  20     argv => [ @ARGV ],
  21   } );
  22   @files = @{$podTester->identify_files_for_POD_testing()};
  23 }
  24
  25 foreach my $file ( @files ) {
  26     foreach my $snippet (get_samples($file)) {
  27         compile_ok($snippet);
  28     }
  29 }
  30
  31 #################### SUBROUTINES ####################
  32
  33 sub compile_ok {
  34     my $snippet = shift;
  35
  36     # If it's a PIR fragment, wrap it in a sub.
  37     if ($snippet->{type} eq "PIR" && $snippet->{modifier} =~ /FRAGMENT/) {
  38         $snippet->{code} = ".sub 'testing'\n" .
  39             $snippet->{code} .  "\n.end";
  40     }
  41
  42     # Generate a temp file for the source.
  43     my ($fh,$tempfile) = tempfile(
  44         SUFFIX => '.' . lc $snippet->{type},
  45         UNLINK => 1
  46     );
  47     print {$fh} $snippet->{code};
  48     close $fh;
  49
  50     # Generate a temp file for stderr
  51     my ($err_fh,$err_tempfile) = tempfile(
  52         SUFFIX => '.err',
  53         UNLINK => 1
  54     );
  55     close $err_fh;
  56
  57     # Send the output to /dev/null; similar to perl5's -c
  58     my $cmd = File::Spec->curdir() . $PConfig{slash} .
  59               $PConfig{test_prog} . " -o " . File::Spec->devnull() . " " .
  60               $tempfile . ' 2> ' . $err_tempfile;
  61
  62     my $description = join (':', map {$snippet->{$_}}
  63         qw(file line type modifier));
  64
  65     my $rc = system($cmd);
  66     open my $errout_fh, '<', $err_tempfile;
  67
  68     my $error_output;
  69     {
  70         undef local $/;
  71         $error_output = <$errout_fh>;
  72     }
  73
  74     my $todo = 0;
  75     $todo = 1 if ($snippet->{modifier} =~ /TODO|INVALID/);
  76     TODO: {
  77         # conditionally todo the file.
  78         local $TODO = 'invalid code' if $todo;
  79
  80         is ($error_output,'',$description);
  81     }
  82 }
  83
  84 sub get_samples {
  85     my $file = shift;
  86
  87     open my $fh, '<', $file;
  88
  89     my @snippets;
  90     my $snippet = {};
  91     my $code = '';
  92     my $target;
  93
  94     my $in_code = 0;
  95     while (my $line = <$fh>) {
  96
  97         if ( $in_code )  {
  98             if ($line =~ /^=end $target$/) {
  99                 $snippet->{code} = $code;
 100                 push @snippets, $snippet;
 101                 $code = '';
 102                 $snippet = {};
 103                 $in_code = 0;
 104             }
 105             else {
 106                 $code .= $line;
 107             }
 108         }
 109         elsif ( $line =~ /^=begin ((PIR|PASM)(_(.*))?)$/ ) {
 110             $in_code = 1;
 111             $snippet->{file} = $file;
 112             $snippet->{line} = $.;
 113             $snippet->{type} = $2;
 114             $snippet->{modifier} = defined($4) ? $4 : '';
 115             $target = $1;
 116         }
 117     }
 118
 119     # We don't check for an example in progress here because no file
 120     # should end with =end.
 121     return @snippets;
 122 }
 123
 124 __END__
 125
 126 =head1 NAME
 127
 128 t/examples/pod.t - Compile examples found in POD
 129
 130 =head1 SYNOPSIS
 131
 132     # test all files
 133     % prove t/examples/pod.t
 134
 135     # test specific files
 136     % perl t/examples/pod.t docs/compiler_faq.pod
 137
 138 =head1 DESCRIPTION
 139
 140 Tests the syntax for any embedded PIR in POD, for all files in the
 141 repository that contain POD.  Any invalid examples are reported in the
 142 test output.
 143
 144 To test a snippet of parrot code, wrap it in C<=begin> and C<=end> blocks
 145 like:
 146
 147  =begin PASM
 148
 149    set I0, 0
 150
 151  =end PASM
 152
 153 C<PASM> and C<PIR> are both valid target languages.
 154
 155 Additionally, you can add the following modifiers (prepending with an
 156 underscore).
 157
 158 =over 4
 159
 160 =item * FRAGMENT
 161
 162 For PIR, wraps the code in a C<.sub> block.
 163
 164 =item * TODO
 165
 166 =item * INVALID
 167
 168 Either of these will force the test to be marked TODO.
 169
 170 =back
 171
 172 For example, this PIR fragment uses an old, invalid opcode and needs
 173 to be updated:
 174
 175  =begin PIR_FRAGMENT_INVALID
 176
 177     find_type $I1, 'Integer'
 178
 179  =end PIR_FRAGMENT_INVALID
 180
 181 As shown, you can "stack" the modifiers. Take care to make the begin and
 182 and end POD targets identical. Always begin with the target language.
 183
 184 =cut
 185
 186 # Local Variables:
 187 #   mode: cperl
 188 #   cperl-indent-level: 4
 189 #   fill-column: 100
 190 # End:
 191 # vim: expandtab shiftwidth=4: