doc/info/update_examples

   1 #!/usr/bin/env perl
   2
   3 use File::Temp qw/ :POSIX /;
   4
   5 use Text::Tabs;
   6
   7 use warnings;
   8 use strict;
   9
  10 my $topdir = substr(`pwd`, 0, -1);
  11
  12 if (index($topdir, "/maxima/doc/info") != -1) {
  13     $topdir =~ s/\/maxima\/doc\/info//;
  14 }
  15 else {
  16     $topdir = '';
  17 }
  18
  19 my $strip_topdir = $ENV{"STRIP_TOPDIR"} || $topdir;
  20
  21 my $maxima_command = $ENV{"MAXIMA_EXAMPLE_COMMAND"} || "../../maxima-local";
  22
  23 my $line_cnt    = 0;
  24 my $error_cnt   = 0;
  25 my $warning_cnt = 0;
  26
  27 my $example_input_beg = '^@c ===beg===';
  28 my $example_input_end = '^@c ===end===';
  29
  30 #my $example_output_beg = '^@example[ \t]*\n';
  31 my $example_output_end = '^@end[ \t]+example[ \t]*\n';
  32
  33 my $in_example_input  = 0;
  34 my $in_example_output = 0;
  35
  36 my @example_input_buf  = ();
  37 my @example_output_buf = ();
  38 my @example_result_buf = ();
  39
  40 sub rem_codes {
  41     my $res;
  42
  43     $res = $_[0];
  44
  45     $res =~ s/\cB//g;
  46     $res =~ s/\cE//g;
  47
  48     $res =~ s/$strip_topdir//g;
  49
  50     # Escape "@" to "@@", as an unescaped at-sign might be interpreted as the
  51     # beginning of a command.
  52     $res =~s/\@/\@\@/g;
  53
  54     $res =~ s/\{/\@\{/g;
  55     $res =~ s/\}/\@\}/g;
  56
  57     $res = expand($res);
  58
  59     return $res;
  60 }
  61
  62 sub r_trim {
  63     my $res;
  64     $res = $_[0];
  65     $res =~ s/\s+$/\n/;
  66     return $res;
  67 }
  68
  69 while (<>) {
  70     $line_cnt++;
  71
  72     if ($in_example_input) {
  73         if ($_ =~ $example_input_end) {
  74             print $_;
  75             $in_example_input  = 0;
  76             $in_example_output = 1;
  77         }
  78         elsif ($_ =~ /\@c */) {
  79             my $fixed;
  80             if (/^\@c input:/) {
  81                 $fixed = substr($_, 9);
  82             }
  83             else {
  84                 $fixed = substr($_, 3);
  85             }
  86             print $_;
  87             push @example_input_buf, r_trim($fixed);
  88         }
  89         else {
  90             $warning_cnt++;
  91             print STDERR "Warning: line $line_cnt - example input lines must begin with \'\@c \'.\n";
  92             print $_;
  93         }
  94     }
  95     elsif ($in_example_output) {
  96         if (/$example_output_end/) {
  97             my $tempf = tmpnam();
  98
  99             my $com = "$maxima_command > $tempf << \\EOF\n";
 100             foreach my $l (@example_input_buf) {
 101                 $com .= $l;
 102             }
 103             $com .= "EOF";
 104
 105             if (system($com)) {
 106                 $error_cnt++;
 107                 print STDERR
 108                   "Error: line $line_cnt - maxima invocation failed.\n";
 109                 print @example_output_buf;
 110                 print "\@end example\n";
 111             }
 112             else {
 113                 if (open(RESULT, $tempf)) {
 114                     @example_result_buf = <RESULT>;
 115
 116                     close RESULT;
 117
 118                     if (!unlink($tempf)) {
 119                         $error_cnt++;
 120                         print STDERR "Error: line $line_cnt - can't delete temp file $tempf\n";
 121                     }
 122
 123                     print "\@example\n";
 124
 125                     until ($#example_result_buf == -1 or $example_result_buf[0] =~ /^\cB/) {
 126                         shift @example_result_buf;
 127                     }
 128
 129                     until ($#example_result_buf == -1 or $#example_input_buf == -1) {
 130                         my @group;
 131
 132                         until ($#example_result_buf == -1 or $example_result_buf[0] =~ /\cE/) {
 133                             push @group, rem_codes($example_result_buf[0]);
 134                             shift @example_result_buf;
 135                         }
 136
 137                         if ($#example_input_buf != -1) {
 138                             push @group, rem_codes(substr(substr($example_result_buf[0], 0, index($example_result_buf[0], "\cE") + 1), 0, -1)) . rem_codes(substr($example_input_buf[0], 0, -1)) . "\n";
 139                             shift @example_input_buf;
 140                             if ($example_result_buf[0] =~ /\cE/ and not $example_result_buf[0] =~ /\cE$/) {
 141                                 $example_result_buf[0] = substr($example_result_buf[0], index($example_result_buf[0], "\cE"));
 142                             }
 143                             else {
 144                                 shift @example_result_buf;
 145                             }
 146                         }
 147
 148                         until ($#example_input_buf == -1 or $example_input_buf[0] =~ /^[\S]/) {
 149                             push @group, rem_codes(substr($example_input_buf[0], 0, -1)) . "\n";
 150                             shift @example_input_buf;
 151                         }
 152                         until ($#example_result_buf == -1 or $example_result_buf[0] =~ /^\cB/) {
 153                             push @group, rem_codes($example_result_buf[0]);
 154                             shift @example_result_buf;
 155                         }
 156
 157                         print "\@group\n" if scalar @group >= 2;
 158                         print @group;
 159                         print "\@end group\n" if scalar @group >= 2;
 160                     }
 161
 162                     print "\@end example\n";
 163                 }
 164                 else {
 165                     $error_cnt++;
 166                     print STDERR "Error: line $line_cnt - can't open temp file $tempf\n";
 167                     print @example_output_buf;
 168                     print "\@end example\n";
 169                 }
 170             }
 171
 172             close RESULT;
 173
 174             @example_result_buf = ();
 175             @example_input_buf  = ();
 176             @example_output_buf = ();
 177             $in_example_output  = 0;
 178         }
 179         else {
 180             push @example_output_buf, $_;
 181         }
 182     }
 183     elsif (/$example_input_beg/) {
 184         print $_;
 185         $in_example_input = 1;
 186     }
 187     else {
 188         print $_;
 189     }
 190 }
 191
 192 if ($in_example_input) {
 193     $error_cnt++;
 194     print STDERR "Error: line $line_cnt - EOF while end of example input is expected.\n";
 195 }
 196 elsif ($in_example_output) {
 197     $error_cnt++;
 198     print STDERR "Error: line $line_cnt - EOF while end of example is expected.\n";
 199     print @example_output_buf;
 200 }
 201
 202 exit $error_cnt;