#!/usr/bin/perl -w
# Copyright 2014, 2015 Kevin Ryde
# This file is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# This file is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see <http://www.gnu.org/licenses/>.
# Maybe:
# GP-Define foo(x) = x+1;
# GP-Test foo(2) == 3
# GP-Inline for(i=1,10, foo(i)==i+1
# GP-Vector
# GP-End
# GP-Constant
# GP-End
# GP-Matrix
# GP-End
#
# GP-Inline check(bool)
# ... names that won't clash
#
# GP-Define all defines at start then all GP-Inline and GP-Test ?
use strict;
use Carp 'croak';
use FindBin;
use File::Spec;
use File::Temp;
use Getopt::Long;
use List::Util 'max';
use IPC::Run;
use POSIX ();
# uncomment this to run the ### lines
# use Smart::Comments;
our $VERSION = 0;
my $action = 'run';
my $verbose = 0;
my $stdin = 0;
my $exit = 0;
my $total_files = 0;
my $total_expressions = 0;
### $action
# in $str change any decimals 0.123 to fractions (123/1000)
sub decimals_to_fractions {
my ($str) = @_;
$str =~ s{(\d*)\.(\d*)}
{length($1) || length($2)
? "($1$2/1".('0' x length($2)).")"
: "$1.$2" # bare dot unchanged
}ge;
return $str;
}
sub test_fh {
my ($fh, $filename) = @_;
my $output_fh;
my $runner_tempfh;
if ($action eq 'run') {
$output_fh = File::Temp->new (TEMPLATE => 'gp-inline-XXXXXX',
SUFFIX => '.gp',
TMPDIR => 1);
} else {
$output_fh = \*STDOUT;
}
my $output = sub {
print $output_fh @_
or die "Error writing: $!";
};
my $output_test = sub {
if ($action ne 'defines') {
$output->(@_);
}
};
$output->(<<'HERE');
/* gp-inline test boilerplate begin */
gp_inline__location = "";
gp_inline__bad_location = "";
gp_inline__notbool_location = "";
gp_inline__good = 0;
gp_inline__bad = 0;
gp_inline__check(location,bool) =
{
gp_inline__location = location;
check(bool);
}
check(bool) =
{
if(bool==1, gp_inline__good++,
bool==0, gp_inline__bad++;
if(gp_inline_location!=gp_inline__bad_location,
print(gp_inline__location": gp-inline fail"),
gp_inline__bad_location=gp_inline_location),
gp_inline__bad++;
if(gp_inline_location!=gp_inline__notbool_location,
print(gp_inline__location": gp-inline expected result 0 or 1, got ",
bool);
gp_inline__notbool_location = gp_inline_location)
);
}
/* gp-inline test boilerplate end */
HERE
# Possible equality check instead of "=="
# gp_inline__equal(got,want) =
# {
# if(x==y,gp_inline__good++,
# gp_inline__bad++;
# print(gp_inline__location": gp-inline fail");
# print("got "got);
# print("want "want));
# print1();
# }
if ($verbose) {
$output->("\\e 1\n");
}
{
my $end = '';
my $within = '';
my $within_linenum;
my $join = '';
my $linenum = 1;
my $prev_type = '';
while (defined (my $line = readline $fh)) {
$linenum = $.;
### $line
### $within
# leave $line as remainder after Test-Pari-XXX
# 12 3 4 5 6
if ($line =~ s{^(([\#%]+|//+|(/\*))\s*|=for\s+)(Test-Pari|TEST-PARI|GP)(-([A-Za-z]+))?:?\s*}{}) {
my $c_comment = $3;
my $type = ($6 || '');
if ($c_comment) {
$line =~ s{\*/\s*$}{}; # strip C comment close */
}
$line =~ s/\n$//;
if ($type eq '') { $type = 'Test'; } # prev Test-Pari 2+2==4
$type = uc($type);
### $type
if ($type eq 'END') {
if (defined $end) {
$output->($end);
undef $end;
} else {
print STDERR "$filename:$linenum: End without Begin\n";
$exit = 1;
}
$within = '';
next;
}
if ($type eq 'TEST') {
if ($within ne 'TEST') {
if ($within ne '') {
print STDERR "$filename:$linenum: still within $within from line $within_linenum\n";
$exit = 1;
}
$within_linenum = $linenum;
$output_test->("gp_inline__test() = \\\n");
}
if ($line =~ /\\$/) {
### test continues after this line ...
$within = 'TEST';
$output_test->("$line\n");
} else {
### test ends at this line ...
# no final : on the filename:linenum so it's disguised from Emacs
# compilation-mode
my $location = gp_quote("$filename:$within_linenum");
$output_test->("$line;\n",
"gp_inline__check($location, gp_inline__test())\n");
$within = '';
}
next;
}
if (! $within && $prev_type eq 'not-gp-inline') {
# location string creation obscured against Emacs compilation-mode
# taking it to be many locations to mark etc
$output->("\ngp_inline__location=",
gp_quote("$filename:$linenum"),
";\n");
}
if ($within) {
print STDERR "$filename:$linenum: still within $within from line $within_linenum\n";
$exit = 1;
}
if ($type eq 'DEFINE') {
$output->($line,"\n");
} elsif ($type eq 'INLINE') {
$output_test->($line,"\n");
} elsif ($type eq 'CONSTANT') {
if ($line =~ /^\s*$/) {
print STDERR "$filename:$linenum: missing name for CONSTANT\n";
$exit = 1;
}
$output->("$line = {");
$join = "\n";
$end = "};\n";
$within = 'CONSTANT';
$within_linenum = $linenum;
} elsif ($type eq 'VECTOR') {
if ($line =~ /^\s*$/) {
print STDERR "$filename:$linenum: missing name for VECTOR\n";
$exit = 1;
}
$output->("$line = {[");
$join = "\n";
$end = "]};\n";
$within = 'VECTOR';
$within_linenum = $linenum;
} elsif ($type eq 'MATRIX') {
if ($line =~ /^\s*$/) {
print STDERR "$filename:$linenum: missing name for MATRIX\n";
$exit = 1;
}
$output->("$line = {[");
$join = "\n";
$end = "]};\n";
$within = 'MATRIX';
$within_linenum = $linenum;
} else {
print STDERR "$filename:$linenum: ignoring unrecognised \"$type\"\n";
}
$prev_type = $type;
} elsif ($within eq 'CONSTANT'
|| $within eq 'VECTOR'
|| $within eq 'MATRIX') {
$line =~ s/(^|[^\\])(\\\\)*%.*//; # % comments
$line =~ s/\\[,;]/ /g; # ignore \, or \; spacing
$line =~ s/\\(phantom|hspace){[^}]*}/ /g; # ignore TeX \phantom{...}
$line =~ s/\\(kern)-?[0-9.]+[a-z]+/ /g; # ignore TeX \kern...
$line =~ s/\{([+-])\}/$1/g; # {+} or {-}
$line =~ s/&/,/g; # & as field separator
$line =~ s|\\[td]?frac\{([^}]*)}\{([^}]*)}|($1)/($2)|g; # \frac{}{}
$line =~ s/\\(sqrt\d+)\s*(i?)/$1$2/g; # \sqrt2 or \sqrt3 i
$line =~ s/([0-9.)]+)[ \t]*i/$1*I/g; # complex number 123 i
$line =~ s/\bi[ \t]*([0-9.]+)/I*$1/g; # complex number i 123
$line =~ s/([+-])[ \t]*(I)\b/$1$2/g; # complex number +- i 123
$line =~ s/\bi\b/I/g; # complex number i -> I
if ($within eq 'MATRIX') {
$line =~ s/\\\\/;/g; # row separator \\
} else {
$line =~ s/;/,/g; # semi as separator
}
$line =~ s|[^-+*/^()0-9.I,; \t]||sg; # strip anything else
$line =~ s/(^|;)(\s*,)+/$1/sg; # strip leading commas
$line =~ s/,(\s*,)+/,/sg; # strip duplicated commas
$line =~ s/,[ \t]*$//; # strip trailing commas
# print "\\ ",$line,"\n";
$line =~ s/[ \t]*$//; # strip trailing whitespace
$line = decimals_to_fractions($line);
if ($line ne '') {
$output->($join,$line,"\n");
$join = ($line =~ /;$/ ? "\n" : ",\n");
}
next;
} else {
### non test line ...
$prev_type = 'not-gp-inline';
}
}
### EOF ...
if ($within) {
print STDERR "$filename:$linenum: end of file within \"$within\"\n";
$exit = 1;
}
}
$output_test->(<<'HERE');
print("Total ",(gp_inline__good+gp_inline__bad)," tests, "gp_inline__good" good, "gp_inline__bad" bad");
if(gp_inline__bad,quit(1))
HERE
if ($action eq 'run') {
$runner_tempfh = File::Temp->new (TEMPLATE => 'gp-inline-XXXXXX',
SUFFIX => '.gp',
TMPDIR => 1);
my $read_filename = gp_quote($output_fh->filename);
print $runner_tempfh <<"HERE";
{
read($read_filename);
}
HERE
# iferr(read($read_filename),err,
# print("rethrow");
# error(err), /* rethrow */
# 0);
# /* print(gp_inline__location,"error reading"); 0 */
if (! IPC::Run::run(['gp',
'--quiet',
'-f',
'--default','recover=0',
# $runner_tempfh->filename,
$output_fh->filename,
],
'<', File::Spec->devnull)) {
$exit = 1;
}
}
}
# Return $str as a string "$str" for use in a gp script.
# Any " quotes etc in $str are suitably escaped.
sub gp_quote {
my ($str) = @_;
$str =~ s/\"/\\"/g;
return '"'.$str.'"';
}
sub test_file {
my ($filename) = @_;
### test_file(): $filename
$total_files++;
open my $fh, '<', $filename
or die "Cannot open $filename: $!";
test_fh($fh, $filename);
close $fh
or die "Error closing $filename: $!";
}
sub test_files {
# ($filename, ...)
foreach my $filename (@_) {
test_file($filename);
}
}
#------------------------------------------------------------------------------
# mainline
{
my $help = sub {
print "gp-inline [--options] filename...\n";
my @opts =
(['-h, --help', 'Print this help'],
['-v, --version', 'Print program version'],
['--verbose', 'Print extra messages'],
['--run', 'Run the inline tests in each FILENAME'],
['--extract', 'Print the test code from each FILENAME'],
['--defines', 'Print just the definitions from each FILENAME'],
);
my $width = 2 + max (map { length ($_->[0]) } @opts);
foreach (@opts) {
printf "%-*s%s\n", $width, $_->[0], $_->[1];
}
print "\n";
exit 0;
};
GetOptions ('help|?' => $help,
version => sub {
print "$FindBin::Script version $VERSION\n";
exit 0;
},
run => sub { $action = 'run' },
defines => sub { $action = 'defines' },
extract => sub { $action = 'extract' },
stdin => \$stdin,
verbose => \$verbose,
)
or exit 1;
($stdin || @ARGV) or $help->();
}
if ($stdin) {
test_fh(\*STDIN, '(stdin)');
}
test_files(@ARGV);
exit $exit;
#------------------------------------------------------------------------------
__END__
# } elsif ($arg eq '-dist') {
# $exit = 1;
# require ExtUtils::Manifest;
# my $href = ExtUtils::Manifest::maniread();
# my @filenames = grep m{^lib/.*\.pm$|^[^/]\.pm$}, keys %$href;
# $good &= $class->test_files(@filenames);
# # if ($exit) {
# # $class->diag ("gp-inline total $total_expressions checks in $total_files files");
# # exit($good ? 0 : 1);
# # }
#
# sub diag {
# my $self = shift;
# if (eval { Test::More->can('diag') }) {
# Test::More::diag (@_);
# } else {
# my $msg = join('', map {defined($_)?$_:'[undef]'} @_)."\n";
# # $msg =~ s/^/# /mg;
# print STDERR $msg;
# }
# }
=for stopwords gp Ryde
=head1 NAME
gp-inline -- run Pari/GP code inline in a document
=head1 SYNOPSIS
gp-inline [--options] filename...
=head1 DESCRIPTION
C<gp-inline> extracts and executes Pari/GP code which from comments inline
in a document such as TeX or POD. It can be used to include checks of
calculations or formulas in the text. For example a TeX document
From which it is seen that $1+1 = 2$.
% Test-Pari 1+1 == 2
is checked by
gp-inline foo.tex
A C<Test-Pari> line should be evaluate to a non-zero value. Usually it's
some sort of comparison or boolean. The evaluation is like a line of C<gp>
input, so semicolons can separate multiple expressions and the last is the
final result.
% Test-Pari my(n=5); 2*n^2 + n == 55
New C<gp> functions or globals can be defined with lines like
% Test-Pari-DEFINE my_func(n) = 2*n + 3;
% Test-Pari-DEFINE my_vector = [ 1, 2, 3, 5 ];
These lines are arbitrary code passed directly to C<gp>. Multi-line
functions or expressions are given by backslashing or braces in usual C<gp>
style.
% Test-Pari-DEFINE long_func(n) = \
% Test-Pari-DEFINE some + long \
% Test-Pari-DEFINE + func + expression;
% Test-Pari-DEFINE my_matrix = {
% Test-Pari-DEFINE [ 1, 2;
% Test-Pari-DEFINE 2, 1 ];
% Test-Pari-DEFINE }
External C<gp> code modules etc can be included with the usual C<read()>.
Normally this will be in a C<Test-Pari-DEFINE>.
% Test-Pari-DEFINE read("my-library.gp");
Tests are run with C<gp -f> so the user's F<~/.gprc> file is not evaluated.
This is designed to give consistent testing, without personal preferences
only wanted for C<gp> interactively etc.
Syntax errors and type errors in tests or defines are generally fatal.
A location string is included in the test form so the backtrace is something
like
*** at top-level: ...inline("foo.tex:153",(()->bar())())
...
which means F<foo.tex> line 153 was the offending C<Test-Pari>.
Errors in C<Test-Pari-DEFINE> statements don't have this location in the
backtrace (since they're a "top-level" evaluation). If the offending part
is not obvious then run C<gp-inline --verbose> to see a C<\e> trace of each
expression. It includes some C<"foo.tex:150"> etc strings which are the
source locations. (Is there a good way to insert a print before an error
backtrace? An C<iferr> trap loses the backtrace.)
=head1 OPTIONS
The command line options are
=over 4
=item --stdin
Read a document from standard input.
=item --run
Run the inline tests in each given file. This is the default action.
=item --extract
Extract the inline C<gp> code from each file and print to standard output.
The output is ready to run with C<gp -f> or similar.
Usually this will be just one input file, otherwise the tests of each are
one after the other and globals left by the first might upset subsequent
tests.
=item --defines
Extract just the definition lines from the given files and print to standard
output. The output is ready to run with C<gp>.
This is good for extracting definitions so they can be used separately in
further calculations or experiments. It's also possible to go the other
way, have definitions in a separate file which the document loads with
C<read()>. Usually it avoids mistakes to keep a definition with the formula
etc in the document. But generic or very large code could be kept separate.
=item --help
Print a brief help message.
=item --version
Print the program version number and exit.
=back
=head1 BUGS
There's no support for a multi-file document where defines would be carried
over from one part to the next.
=head1 SEE ALSO
L<gp(1)>
=head1 HOME PAGE
http://user42.tuxfamily.org/gp-inline/index.html
=head1 LICENSE
Copyright 2015 Kevin Ryde
gp-inline is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
gp-inline is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along
with gp-inline. If not, see <http://www.gnu.org/licenses/>.
=cut