1-test_emacs_regexps.t

#!/usr/bin/perl
# 1-test_emacs_regexps.t                   doom@kzsu.stanford.edu
#                                          01 Oct 2007

use warnings;
use strict;
$|=1;
our $VERSION = 0.01;

use Data::Dumper;
use Test::More qw(no_plan);

use File::Path     qw(mkpath);
use File::Basename qw(fileparse basename dirname);
# use Fatal          qw( open close mkpath copy move );

use Env qw(HOME);
use FindBin qw( $Bin );
use lib "$Bin/../../lib/perl";

use Run::Emacs qw( emacs_version );

use Getopt::Long;
my %opt = ();
GetOptions( \%opt, "debug|d" );
my $DEBUG = $opt{debug} || 0;

my $prog = basename($0);

my $tempdir = "$Bin/tmp";
mkpath( $tempdir );

# elisp pattern (used by perlnow.el) to pick out the name of
# a perl module from the package line in a *.pm file
# goal: test that this pattern works on various cases
my $elisp_pattern = "^[ \t]*package[ \t\n]+\\(.*?\\)[ \t\n;]";

# test cases (strings we'll match against, paired with expected result);
my @cases = ( [] ); # initialize with a dummy to occupy position 0
@cases = (
          [  'package My::Perl::Module;',
             'My::Perl::Module',
             "Simple",
          ],
          [  'packageNot::That::I::Know::Of;',
             'nil',
             "Expected failure: no space after 'package'",
          ],
          [  'package My::Perl::Module; {',
             'My::Perl::Module',
             "Open bracket same line as semi-colon",
          ],
          [
            'package My::Perl::Module; blah',
            'My::Perl::Module',
             "a string after semi-colon",
          ],
          [
            'package My::Perl::Module::Again ;',
            'My::Perl::Module::Again',
             "Space before semi-colon",
          ],

          [
            "package\nNo::Such::Animal\n;",
            'No::Such::Animal',
             "linebreak seperators",
          ],
         );

# write these test cases to temp files we can try our regexp on
for my $i (1 .. $#cases) {
  my $case = $cases[ $i ];
  my $case_text = $case->[0];
  my $case_file = define_case_file( $i );
  open my $fh, ">", $case_file or die "$!";
  print {$fh} "$case_text\n\n";
  close $fh;
  $i++;
}

my $func_name = "doom-test-elisp-regexp";

$elisp_pattern =~ s{\\}{\\\\}xg;

for my $i (1 .. $#cases) {
  # log file for emacs errors
  my $log = "/home/doom/tmp/emacs_batch-$i.log";

  # Use this temp file to pass data from elisp to perl
  my $tempfile     = "$tempdir/result-$prog-$i.txt";
  if (-e $tempfile) {
    unlink( $tempfile ) or warn "could not delete $tempfile: $!";
  }

  my $case_file = define_case_file( $i );

  my $elisp = define_elisp( $case_file,
                            $tempfile,
                            $elisp_pattern,
                            $func_name );

  ($DEBUG) && print STDERR "Going to run elisp: \n", $elisp, "\n";

  my $emacs_cmd;
  if (emacs_version() < 22) {
    $emacs_cmd =
      "emacs -q --batch  -eval '$elisp' -f $func_name >& $log";
  } else {
    $emacs_cmd =
      "emacs -q --batch --no-splash -eval '$elisp' -f $func_name >& $log";
  }

  system($emacs_cmd);

  # Get the package name
  my $package_name = '';
  if ( open my $fh, "<", $tempfile ) {

    while (my $line = <$fh>) {
      if( $line =~ m{ (\d) : \s* (.*?) $ }msx ) {
        $package_name = $2;
      }
    }

  } else { # distinguish between a failed match and some other problem.
    $package_name = undef;

    open my $log_fh, "<", $log;
    LINE:
    while ( my $line = <$log_fh> ) {
      if( $line =~ m{ ^ \s* Search \s+ failed: \s+  }x ) {
        $package_name = 'nil';  # TODO would an empty string be better?
        last LINE;
      }
    }
  }

  # is $package_name expected value?
  my $expected = $cases[ $i ][ 1 ];
  my $label    = $cases[ $i ][ 2 ];
  is( $package_name, $expected, "Testing case number $i: $label");
}

### end main, into the subs

sub define_case_file {
  my $index = shift;
  my $case_file = "$tempdir/test-$index.pm";
  return $case_file;
}

### the heredoc ghetto

sub define_elisp {
  my $case_file     = shift;
  my $tempfile      = shift;
  my $elisp_pattern = shift;
  my $func_name     = shift;

my $elisp =<<"END_ELISP";
 (defun $func_name ()
  (find-file "$case_file")
  (goto-char (point-min))
  (re-search-forward "$elisp_pattern")
  (setq first_capture (match-string 1))
  (find-file "$tempfile")
  (insert "1: " first_capture)
  (save-buffer))
END_ELISP
  return $elisp
}

# ($func_name)

__END__

=head1 NAME

1-test_emacs_regexps.t - use perl to test emacs via batch mode

=head1 SYNOPSIS

  perl 1-test_emacs_regexps.t

=head1 DESCRIPTION

B<1-test_emacs_regexps.t> is a script which demonstrates the
technique of testing the behavior of elisp from perl, by shelling
out to an emacs run in batch mode.


=head2 running emacs non-interactively

This is conceptually simple, but not as straight-forward as you
might think.

The key feature is "--batch" which allows us to run emacs in
a non-interactive mode.

The two other important features we use to tell emacs
what code to run:

   `-f FUNCTION'
   `--funcall=FUNCTION'
        Call Lisp function FUNCTION.

   `--eval=EXPRESSION'
   `--execute=EXPRESSION'
      Evaluate Lisp expression EXPRESSION.


One minor annoyance is that emacs 22 has introduced a "splash"
screen unless you're told it not to:

  --no-splash

But using this is an error in earlier versions of emacs.
So we need to check what we have, using a seperate invocation
of emacs with the "--version" option (this code is sequestered
away in the emacs_version routine inside the Run::Emacs module).


Another detail: it's often useful to run emacs in it's default
configuration, supressing the usual init files (.emacs, etc):

   --no-init-file  aka -q
   --no-site-file


In non-interactive mode, emacs can, of course, modify files
which is the form of output I've used for this test script.
It can also send output to STDERR: the "message" command
is re-directed to there when running in --batch mode.


=head2 elisp

The generated elisp looks like this:

 (defun doom-test-elisp-regexp ()
  (find-file "/home/doom/End/Cave/GuiTest/Wall/code/tmp/test-0.pm")
  (goto-char (point-min))
  (re-search-forward "^[ 	]*package[
]+\\(.*?\\)[
;]")
  (setq first_capture (match-string 1))
  (find-file "/home/doom/End/Cave/GuiTest/Wall/code/tmp/result-1-test_emacs_regexps.t-0.txt")
  (insert "1: " first_capture)
  (save-buffer))

 (doom-test-elisp-regexp)

(There's probably other ways to do this... does the message function
write to STDOUT in non-interactive mode?  Try that... TODO)

( it's supposed to go to STDERR )

=head1 AUTHOR

Joseph Brenner, Edoom@kzsu.stanford.eduE

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Joseph Brenner

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=cut