r12235 - in /branches/upstream/libvi-quickfix-perl/current: Changes META.yml README Todo lib/Vi/QuickFix.pm t/001_basic.t

ghostbar-guest at users.alioth.debian.org ghostbar-guest at users.alioth.debian.org
Tue Jan 8 17:21:18 UTC 2008


Author: ghostbar-guest
Date: Tue Jan  8 17:21:17 2008
New Revision: 12235

URL: http://svn.debian.org/wsvn/?sc=1&rev=12235
Log:
[svn-upgrade] Integrating new upstream version, libvi-quickfix-perl (1.134)

Modified:
    branches/upstream/libvi-quickfix-perl/current/Changes
    branches/upstream/libvi-quickfix-perl/current/META.yml
    branches/upstream/libvi-quickfix-perl/current/README
    branches/upstream/libvi-quickfix-perl/current/Todo
    branches/upstream/libvi-quickfix-perl/current/lib/Vi/QuickFix.pm
    branches/upstream/libvi-quickfix-perl/current/t/001_basic.t

Modified: branches/upstream/libvi-quickfix-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libvi-quickfix-perl/current/Changes?rev=12235&op=diff
==============================================================================
--- branches/upstream/libvi-quickfix-perl/current/Changes (original)
+++ branches/upstream/libvi-quickfix-perl/current/Changes Tue Jan  8 17:21:17 2008
@@ -50,3 +50,26 @@
        - fixed bug concerning "perl -MVi::QuickFix source" when source also
          has "use Vi::QuickFix" (there was some double processing)
        - released
+
+Vi-QuickFix-1_132 Tue Jan  1 02:51:29 CET 2008
+       - Fixed bugs that came up with different warnings processing in 5.10.0
+       - Added eval-detection in sig mode
+       - Made error file handle autoflushing
+       - Fixed obligatory message so invocation is correctly identified
+
+Thu Jan  3 03:07:41 CET 2008
+       - Parsing of ambigous message texts, with existence test
+       - Added fork mode (experimental, tests fail intermittently)
+
+Sat Jan  5 04:23:34 CET 2008
+       - released
+
+Vi-QuickFix-1_133 Sat Jan  5 18:36:06 CET 2008
+       - removed test in fork mode
+       - released
+
+Vi_QuickFix_1_134 Sun Jan  6 23:56:31 CET 2008
+       - fixed a rather embarrassing mistake in t/001_basic. Calling
+         $^X now instead of 'perl'.  That would account for "mysterious"
+         fails with cpan testers.
+       - released

Modified: branches/upstream/libvi-quickfix-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libvi-quickfix-perl/current/META.yml?rev=12235&op=diff
==============================================================================
--- branches/upstream/libvi-quickfix-perl/current/META.yml (original)
+++ branches/upstream/libvi-quickfix-perl/current/META.yml Tue Jan  8 17:21:17 2008
@@ -1,11 +1,14 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Vi-QuickFix
-version:      1.129
-version_from: lib/Vi/QuickFix.pm
-installdirs:  site
-requires:
+--- #YAML:1.0
+name:                Vi-QuickFix
+version:             1.134
+abstract:            Support for vim's QuickFix mode
+license:             ~
+author:              
+    - Anno Siegel (siegel at zrz.tu-berlin.de)
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
     Test::Simple:                  0.44
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: branches/upstream/libvi-quickfix-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libvi-quickfix-perl/current/README?rev=12235&op=diff
==============================================================================
--- branches/upstream/libvi-quickfix-perl/current/README (original)
+++ branches/upstream/libvi-quickfix-perl/current/README Tue Jan  8 17:21:17 2008
@@ -7,7 +7,7 @@
       use Vi::QuickFix <options>;
       use Vi::QuickFix <options> <errorfile>;
 
-    where "<options>" is one or more of "silent", "sig", and "tie".
+    where "<options>" is one or more of "silent", "sig", "tie", and "fork".
 
 DESCRIPTION
     When "Vi::QuickFix" is active, Perl logs errors and warnings to an
@@ -42,9 +42,9 @@
     will take you there when other error entries don't point it elsewhere.
     Use the "silent" option with "Vi::QuickFix" to suppress this warning.
 
-    It is a fatal error when the error file cannot be opened. If the error
-    file is empty (can only happen with "silent"), it is removed at the end
-    of the run.
+    When the error file cannot be opened, a warning is issued and the
+    program continues running without QuickFix support. If the error file is
+    empty after the run (can only happen with "silent"), it is removed.
 
 ENVIRONMENT
     "Vi::QuickFix" recognizes the environment variable
@@ -77,22 +77,31 @@
 IMPLEMENTATION
     For a debugging tool, an implementation note is in order.
 
-    Perl offers to obvious ways to watch and capture its error output. One
-    is through the (pseudo-) signal handlers $SIG{__WARN__} and
+    Perl offers three obvious ways to watch and capture its error output.
+    One is through the (pseudo-) signal handlers $SIG{__WARN__} and
     $SIG{__DIE__}. The other is through "tie"-ing the "STDERR" file handle.
+    A third method involves forking a child process for the capturing and
+    redirect "STDERR" to there.
 
-    "Vi::QuickFix" can use either method to create the error file. As it
-    turns out, the ability to tie "STDERR" is relatively new with Perl, as
-    of version 5.8.1. With Versions 5.8.0 and earlier, a number of internal
-    errors and warnings don't respect tie, so this method cannot be used.
-    With Perl versions ealier than 5.8.1, "Vi::QuickFix" uses %SIG handlers
-    to catch messages. With newer versions, "Vi::Quickfix" ties "STDERR" so
-    that it (additionally) writes to the error file.
+    "Vi::QuickFix" can use these three methods to create the error file. As
+    it turns out, the ability to tie "STDERR" is relatively new with Perl,
+    as of version 5.8.1. With Versions 5.8.0 and earlier, a number of
+    internal errors and warnings don't respect tie, so this method cannot be
+    used. With Perl versions ealier than 5.8.1, "Vi::QuickFix" uses %SIG
+    handlers to catch messages. With newer versions, "Vi::Quickfix" ties
+    "STDERR" so that it (additionally) writes to the error file. The forking
+    method can be used with any version of Perl.
 
-    A specific method can be requested through the options "sig" and "tie",
-    as in
+    A specific method can be requested through the options "sig", "tie" and
+    "fork", as in
 
-        use Vi::QuickFix qw( sig);
+        use Vi::QuickFix qw(sig);
+        use Vi::QuickFix qw(tie);
+        use Vi::QuickFix qw(fork);
+
+    The forking method appears to work well in practice, but a race
+    condition exists that intermittently leads to failing tests. It is not
+    tested in the standard test suite and must be considered experimental.
 
     Requesting "tie" with a Perl version that can't handle it is a fatal
     error, so the only option that does anything useful is "sig" with a
@@ -100,13 +109,10 @@
     the surrounding code.
 
 CONFLICTS
-    Such a conflict can occur with the "sig" method as well, and it can
+    Similar conflicts can occur with the "sig" method as well, and it can
     happen in two ways. Either "Vi::QuickFix" already finds a resource (a
     %SIG handler or a tie on "STDERR") occupied at "use" time, or the
     surrounding code commandeers the resource after the fact.
-
-    All such conflicts can be avoided by using "Vi::QuickFix" in a separate
-    process, as noted under ""USAGE".
 
     However, if "STDERR" is already tied when "Vi::QuickFix" is "use"d, it
     cannot employ the "tie" method, and by default reverts to "sig". If the
@@ -131,7 +137,7 @@
     are code objects just for this reason.
 
 VERSION
-    This document pertains to "Vi::Quickfix" version 1.129
+    This document pertains to "Vi::Quickfix" version 1.134
 
 BUGS
     "no Vi::QuickFix" has no effect

Modified: branches/upstream/libvi-quickfix-perl/current/Todo
URL: http://svn.debian.org/wsvn/branches/upstream/libvi-quickfix-perl/current/Todo?rev=12235&op=diff
==============================================================================
--- branches/upstream/libvi-quickfix-perl/current/Todo (original)
+++ branches/upstream/libvi-quickfix-perl/current/Todo Tue Jan  8 17:21:17 2008
@@ -1,5 +1,9 @@
 TODO list for Perl module Vi::QuickFix
 
-- Nothing yet
+Fri Aug 12 01:22:04 CEST 2005
+don't die if error file can't be created (run without quickfix)
+done Tue Jan  1 06:31:56 CET 2008
 
-
+Tue Jan  1 05:51:13 CET 2008
+run tests with relevant earlier versions of perl (dependency on warnings)
+done Tue Jan  1 15:24:42 CET 2008

Modified: branches/upstream/libvi-quickfix-perl/current/lib/Vi/QuickFix.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libvi-quickfix-perl/current/lib/Vi/QuickFix.pm?rev=12235&op=diff
==============================================================================
--- branches/upstream/libvi-quickfix-perl/current/lib/Vi/QuickFix.pm (original)
+++ branches/upstream/libvi-quickfix-perl/current/lib/Vi/QuickFix.pm Tue Jan  8 17:21:17 2008
@@ -2,41 +2,36 @@
 package Vi::QuickFix;
 use 5.008_000;
 use strict; use warnings;
-use Carp;
+# use Carp;
 
 our $VERSION;
 BEGIN {
-    $VERSION = ('$Revision: 1.129 $' =~ /(\d+.\d+)/)[ 0];
+    $VERSION = ('$Revision: 1.134 $' =~ /(\d+.\d+)/)[ 0];
 }
 
 unless ( caller ) {
     # process <> if called as an executable
-    set_exec_mode(); # signal fact ( to END processing)
+    exec_mode(1); # signal fact ( to END processing)
     require Getopt::Std;
     Getopt::Std::getopts( 'q:f:v', \ my %opt);
     print "$0 version $VERSION\n" and exit 0 if $opt{ v};
     err_open( $opt{ q} || $opt{ f});
-    print && err_print( $_) while <>;
+    print && err_out( $_) while <>;
     exit;
 }
 
 ###########################################################################
 
 # keywords for ->import
-use constant KEYWORDS => qw( silent sig tie);
+use constant KEYWORDS => qw(silent sig tie fork);
 
 # environment variable(s)
 use constant VAR_SOURCEFILE => 'VI_QUICKFIX_SOURCEFILE';
 
 BEGIN {{ # space for private variables
 
-# user parameters:
-my $errfile = 'errors.err'; # name of error file
-my $silent = 0;             # switch off otherwise obligatory warning
 my $relay = '';             # method of transfer to error file: "sig" or "tie"
-
-sub make_silent { $silent = 1 }
-sub is_silent { $silent } # should this be a package variable?
+my %invocation;             # from where was import() called?
 
 sub import {
     my $class = shift;
@@ -44,71 +39,122 @@
     @keywords{ KEYWORDS()} = ();
     $keywords{ shift()} = 1 while @_ and exists $keywords{ $_[ 0]};
 
-    err_open( shift);
-    make_silent if $keywords{ silent};
-    my ( $wanted_relay) = grep $keywords{ $_}, qw( sig tie);
+    my $filename = shift;
+    make_silent() if $keywords{ silent};
+    my ( $wanted_relay) = grep $keywords{ $_}, qw( sig tie fork);
     $relay = $wanted_relay || default_relay();
     if ( my $reason = relay_obstacle( $relay) ) {
         croak( "Cannot use '$relay' method: $reason");
     }
-    if ( $relay eq 'tie' and not tied *STDERR ) {
+    err_open($filename) unless $relay eq 'fork'; # happens in background
+    if ( $relay eq 'tie' ) {
         # if tied, it's tied to ourselves (otherwise obstacle)
-        tie *STDERR, 'Vi::QuickFix::Tee', '>&STDERR';
+        tie *STDERR, 'Vi::QuickFix::Tee', '>&STDERR' unless tied *STDERR;
     } elsif ( $relay eq 'sig' ) {
         $SIG{ $_} = Vi::QuickFix::SigHandler->new( $_) for
             qw( __WARN__ __DIE__);
-    }
+    } elsif ( $relay eq 'fork' ) {
+        *STDERR = fork_relay($filename);
+    }
+    # save invocation for obligate message
+    (undef, @invocation{qw(file line)}) = caller;
 }
 
 # internal variables
-my $errhandle; # write formatted errors here
-my $errcount;  # for END to know if file can be erased. (-s would need flush)
-               # otherwise unused
-my $exec_mode; # set if lib file is run as a script
-sub set_exec_mode { $exec_mode = 1 }
-
-# open the given file (or default), set $errfile and $errhandle
-sub err_open {
-    $errfile = shift || 'errors.err';
-    $errhandle = IO::File->new( "> $errfile") or croak(
-        "Can't create error file '$errfile': $!"
-    );
-}
-
-sub err_close { close $errhandle if $errhandle }
-
-use Carp;
-# write to the error file and increase errcount if appropriate,
-use constant PERL_MSG => qr/^(.*?) at (.*?) line (\d+)(\.?|,.*)$/;
-sub err_print {
+{
+    my $exec_mode; # set if lib file is run as a script
+    sub exec_mode {
+        $exec_mode = shift if @_;
+        $exec_mode;
+    }
+    
+    my $silent = 0;             # switch off otherwise obligatory warning
+    sub make_silent { $silent = 1 }
+    sub is_silent { $silent }
+
+    my $errfile = 'errors.err'; # name of error file
+    my $errhandle; # write formatted errors here
+    # open the given file (or default), set $errfile and $errhandle
+    sub err_open {
+        $errfile = shift || 'errors.err';
+        $errhandle = IO::File->new( $errfile, '>') or warn(
+            "Can't create error file '$errfile': $!"
+        );
+        $errhandle->autoflush if $errhandle;
+    }
+
+    sub err_print {
+        print $errhandle @_ if $errhandle;
+    }
+
+    sub err_clean {
+        my $unlink = shift;
+        close $errhandle if $errhandle;
+        unlink $errfile if $errfile and $unlink and not -s $errfile;
+    }
+}
+
+sub err_out {
     # handle multiple, possibly multi-line messages (though usually
     # there will be only one)
-#   Carp::confess( 'err_print');
     for ( map split( /\n+/), @_ ) {
-        my ( $message, $file, $line, $rest) = $_ =~ PERL_MSG or next;
-        $message .= $rest if $rest =~ s/^,//;
-        $file eq '-' and defined and $file = $_ for $ENV{ VAR_SOURCEFILE()};
-        print $errhandle "$file:$line:$message\n";
-        $errcount ++;
-    }
+        my $out;
+        if ( /.+:\d+:/ ) { # already in QuickFix format, pass on
+            err_print("$_\n");
+        } else {
+            for ( parse_perl_msg($_) ) {
+                my ( $message, $file, $line, $rest) = @$_ or next;
+                $message .= $rest if $rest =~ s/^,//;
+                $file eq '-' and defined and $file = $_ for
+                    $ENV{ VAR_SOURCEFILE()};
+                err_print("$file:$line:$message\n");
+            }
+        }
+    }
+}
+
+# use constant PERL_MSG => qr/^(.*?) at (.*?) line (\d+)(\.?|,.*)$/;
+sub parse_perl_msg {
+    my @coll;
+    for ( shift ) {
+        while ( m/ at /g ) {
+            my $text = substr($_, 0, $-[0]);
+            my $pos = pos;
+            while ( m/ line (\d+)(\.?|,.*)$/g ) {
+                my $file = substr($_, $pos, $-[0] - $pos);
+                my $line = $1;
+                my $rest = $2;
+                push @coll, [$text, $file, $line, $rest];
+            }
+            pos = $pos;
+        }
+    }
+    return @coll if @coll <= 1;
+    my @existing = grep -e $_->[1], @coll;
+    return @existing if @existing;
+    return @coll;
 }
 
 # issue warning, erase error file
 my $end_entiteled = $$;
 END {
     # issue warning (only original process, and not in exec mode)
-    carp "QuickFix active" unless
-        is_silent or $exec_mode or $$ != $end_entiteled;
+    unless ( is_silent or exec_mode() or $$ != $end_entiteled ) {
+        my $invocation_at = "at $invocation{file} line $invocation{line}";
+        warn "QuickFix ($relay) active $invocation_at\n";
+    }
     # silently remove objects
     make_silent();
     if ( $relay eq 'tie' ) {
         untie *STDERR;
-    } else {
+    } elsif ( $relay eq 'sig' ) {
         $SIG{ $_} = 'DEFAULT' for qw( __WARN__ __DIE__);
-    }
-    # remove file if created by us and empty (only original process)
-    err_close(); # so we can unlink under windows
-    unlink $errfile if not $errcount and $$ == $end_entiteled;
+    } elsif ( $relay eq 'fork' ) {
+        close STDERR;
+        wait_kid();
+    }
+    # remove file if created by us and empty
+    err_clean($$ == $end_entiteled);
 }
 
 }}
@@ -129,6 +175,38 @@
 }
 
 sub default_relay { relay_obstacle( 'tie') ? 'sig' : 'tie' }
+
+{
+    use Carp;
+    my ($read, $write, $kid);
+    sub fork_relay {
+        my $filename = shift;
+        my $parent = $$;
+        pipe $read, $write;
+        if ( $kid = fork ) {
+            # parent
+            close $read;
+            return $write;
+        } else {
+            Carp::croak "Can't fork: $!" unless  defined $kid;
+            # kid
+            close $write;
+            err_open($filename);
+            while ( <$read> ) {
+                print STDERR $_;
+                err_out($_);
+            }
+            err_clean(1);
+            exit;
+        }
+    }
+
+    use POSIX ":sys_wait_h";
+    sub wait_kid {
+        my $x;
+        do { $x = waitpid -1, WNOHANG } while $x > 0;
+    }
+}
 
 # common destructor method
 package Vi::QuickFix::Destructor;
@@ -141,7 +219,7 @@
     my $id = $ob->id;
     my $msg = shortmess( "QuickFix $id processing interrupted");
     # simulate intact QuickFix processing
-    Vi::QuickFix::err_print( $msg);
+    Vi::QuickFix::err_out( $msg);
     warn "$msg";
 }
 
@@ -156,7 +234,7 @@
     my $prev_handler = $SIG{ $sig};
     my $sub = sub {
         return $sig unless @_; # backdoor
-        Vi::QuickFix::err_print( @_);
+        Vi::QuickFix::err_out( @_) unless $sig eq '__DIE__' and  _in_eval();
         my $code;
         # resolve string at call time
         if ( $prev_handler ) {
@@ -171,6 +249,14 @@
     bless $sub, $class; # so we can have a destructor
 }
 
+sub _in_eval {
+    my $i = -1; # first call with 0
+    while ( defined(my $sub = (caller ++ $i)[3]) ) {
+        return 1 if $sub =~ /^\(eval/;
+    }
+    return 0;
+}
+
 sub id {
     my $handler = shift;
     $handler->(); # call without args returns __WARN__ or __DIE__
@@ -186,8 +272,8 @@
 sub WRITE {
     my $fh = shift;
     my ( $scalar, $length) = @_;
-    Vi::QuickFix::err_print( $scalar);
-    $fh->SUPER::WRITE( @_);
+    Vi::QuickFix::err_out( $scalar);
+    $fh->Tie::StdHandle::WRITE( @_);
 }
 
 sub id { 'STDERR' }
@@ -207,7 +293,8 @@
   use Vi::QuickFix <options>;
   use Vi::QuickFix <options> <errorfile>;
 
-where C<E<lt>optionsE<gt>> is one or more of C<silent>, C<sig>, and C<tie>.
+where C<E<lt>optionsE<gt>> is one or more of C<silent>, C<sig>,
+C<tie>, and C<fork>.
 
 =head1 DESCRIPTION
 
@@ -244,9 +331,9 @@
 don't point it elsewhere.  Use the C<silent> option with C<Vi::QuickFix> to
 suppress this warning.
 
-It is a fatal error when the error file cannot be opened.  If the error
-file is empty (can only happen with C<silent>), it is removed at the end
-of the run.
+When the error file cannot be opened, a warning is issued and the program
+continues running without QuickFix support.  If the error file is empty
+after the run (can only happen with C<silent>), it is removed.
 
 =head1 ENVIRONMENT
 
@@ -281,23 +368,31 @@
 
 For a debugging tool, an implementation note is in order.
 
-Perl offers to obvious ways to watch and capture its error output.
+Perl offers three obvious ways to watch and capture its error output.
 One is through the (pseudo-) signal handlers C<$SIG{__WARN__}> and
 C<$SIG{__DIE__}>.  The other is through C<tie>-ing the C<STDERR> file
-handle.
-
-C<Vi::QuickFix> can use either method to create the error file.
+handle.  A third method involves forking a child process for the
+capturing and redirect C<STDERR> to there.
+
+C<Vi::QuickFix> can use these three methods to create the error file.
 As it turns out, the ability to tie C<STDERR> is relatively new with
 Perl, as of version 5.8.1.  With Versions 5.8.0 and earlier, a number
 of internal errors and warnings don't respect tie, so this method
 cannot be used.  With Perl versions ealier than 5.8.1, C<Vi::QuickFix>
 uses %SIG handlers to catch messages.  With newer versions, C<Vi::Quickfix>
 ties C<STDERR> so that it (additionally) writes to the error file.
-
-A specific method can be requested through the options C<sig> and
-C<tie>, as in
-
-    use Vi::QuickFix qw( sig);
+The forking method can be used with any version of Perl.
+
+A specific method can be requested through the options C<sig>,
+C<tie> and C<fork>, as in
+
+    use Vi::QuickFix qw(sig);
+    use Vi::QuickFix qw(tie);
+    use Vi::QuickFix qw(fork);
+
+The forking method appears to work well in practice, but a race condition
+exists that intermittently leads to failing tests.  It is not tested
+in the standard test suite and must be considered experimental.
 
 Requesting C<tie> with a Perl version that can't handle it is a
 fatal error, so the only option that does anything useful is C<sig>
@@ -306,13 +401,10 @@
 
 =head1 CONFLICTS
 
-Such a conflict can occur with the C<sig> method as well, and it can
+Similar conflicts can occur with the C<sig> method as well, and it can
 happen in two ways.  Either C<Vi::QuickFix> already finds a resource
 (a C<%SIG> handler or a tie on C<STDERR>) occupied at C<use> time, or the
 surrounding code commandeers the resource after the fact.
-
-All such conflicts can be avoided by using C<Vi::QuickFix> in a
-separate process, as noted under L</"USAGE>.
 
 However, if C<STDERR> is already tied when C<Vi::QuickFix> is C<use>d, 
 it cannot employ the C<tie> method, and by default reverts to C<sig>.
@@ -338,7 +430,7 @@
 
 =head1 VERSION
 
-This document pertains to C<Vi::Quickfix> version 1.129
+This document pertains to C<Vi::Quickfix> version 1.134
 
 =head1 BUGS
 

Modified: branches/upstream/libvi-quickfix-perl/current/t/001_basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libvi-quickfix-perl/current/t/001_basic.t?rev=12235&op=diff
==============================================================================
--- branches/upstream/libvi-quickfix-perl/current/t/001_basic.t (original)
+++ branches/upstream/libvi-quickfix-perl/current/t/001_basic.t Tue Jan  8 17:21:17 2008
@@ -2,8 +2,6 @@
 use strict; use warnings;
 use Test::More;
 my $n_tests;
-
-# goto this;
 
 use constant DEVNULL => $^O eq 'MSWin32' ? 'NUL' : '/dev/null';
 use constant REDIRECT => '>' . DEVNULL . ' 2>' . DEVNULL;
@@ -19,13 +17,13 @@
 
 BEGIN { $n_tests += 2 * PER_CALL }
 {{
-my $command = qq(perl -Ilib -e");
+my $command = qq($^X -Ilib -e");
 $command .= qq(use Vi::QuickFix;);
 $command .= qq( warn qq($_); print STDERR qq(# something else\\n);) for ERR_TXT;
 $command .= Q_REDIRECT;
 run_tests( 'module_use', 'std', $command);
 
-$command = qq(perl -Ilib -MVi::QuickFix -e");
+$command = qq($^X -Ilib -MVi::QuickFix -e");
 $command .= qq( warn qq($_);) for ERR_TXT;
 $command .= Q_REDIRECT;
 run_tests( 'module_switch', 'std', $command);
@@ -34,12 +32,12 @@
 
 BEGIN { $n_tests += 2 * PER_CALL }
 {{
-my $command = qq(perl -Ilib -MVi::QuickFix=*ERRFILE* -e");
+my $command = qq($^X -Ilib -MVi::QuickFix=*ERRFILE* -e");
 $command .= qq(warn qq($_); ) for ERR_TXT;
 $command .= Q_REDIRECT;
 run_tests( 'module_switch', 'mine', $command);
 
-$command = qq(perl -Ilib -e");
+$command = qq($^X -Ilib -e");
 $command .= qq(use Vi::QuickFix "*ERRFILE*"; );
 $command .= qq(warn qq($_); print STDERR qq(something else\\n); ) for ERR_TXT;
 $command .= Q_REDIRECT;
@@ -58,12 +56,12 @@
 SKIP: {{
 skip REASON_LOW, 2 * PER_CALL if LOW_VERSION;
 
-my $command = qq(perl -Ilib -MVi::QuickFix=sig -e");
+my $command = qq($^X -Ilib -MVi::QuickFix=sig -e");
 $command .= qq(warn qq($_); ) for ERR_TXT;
 $command .= Q_REDIRECT;
 run_tests( 'module_switch(sig)', 'std', $command);
 
-$command = qq(perl -Ilib -e");
+$command = qq($^X -Ilib -e");
 $command .= qq(use Vi::QuickFix qw( sig); );
 $command .= qq(warn qq($_); print STDERR qq(# something else\\n); ) for ERR_TXT;
 $command .= Q_REDIRECT;
@@ -74,12 +72,12 @@
 SKIP: {{
 skip REASON_LOW, 2 * PER_CALL if LOW_VERSION;
 
-my $command = qq(perl -Ilib -MVi::QuickFix=sig,*ERRFILE* -e");
+my $command = qq($^X -Ilib -MVi::QuickFix=sig,*ERRFILE* -e");
 $command .= qq(warn qq($_); ) for ERR_TXT;
 $command .= Q_REDIRECT;
 run_tests( 'module_switch(sig)', 'mine', $command);
 
-$command = qq(perl -Ilib -e");
+$command = qq($^X -Ilib -e");
 $command .= qq(use Vi::QuickFix "sig", "*ERRFILE*"; );
 $command .= qq(warn qq($_); print STDERR qq(something else\\n); ) for ERR_TXT;
 $command .= Q_REDIRECT;
@@ -95,11 +93,11 @@
 
 BEGIN { $n_tests += 2 * ( PER_CALL + 1) }
 {{
-my $command = qq(perl lib/Vi/QuickFix.pm infile >outfile 2>) . DEVNULL;
+my $command = qq($^X lib/Vi/QuickFix.pm infile >outfile 2>) . DEVNULL;
 run_tests( 'command_file', 'std', $command);
 is( -s 'outfile', -s 'infile', 'input copied to stdout');
 
-$command = qq(perl ./lib/Vi/QuickFix.pm <infile >outfile 2>) . DEVNULL;
+$command = qq($^X ./lib/Vi/QuickFix.pm <infile >outfile 2>) . DEVNULL;
 run_tests( 'command_stdin', 'std', $command);
 is( -s 'outfile', -s 'infile', 'file copied to stdout');
 }}
@@ -108,50 +106,100 @@
 {{
 
 # check -v key (version)
-my $command = qq(perl lib/Vi/QuickFix.pm -v);
+my $command = qq($^X lib/Vi/QuickFix.pm -v);
 open my $f, "$command |";
-ok( defined $f, "Got a handle");
+ok( defined $f, "got a handle");
 like( scalar <$f>, qr/version *\d+\.\d+/, "-v returns version");
 
-$command = qq(perl lib/Vi/QuickFix.pm -f *ERRFILE* infile) . REDIRECT;
+$command = qq($^X lib/Vi/QuickFix.pm -f *ERRFILE* infile) . REDIRECT;
 run_tests( 'command_file', 'mine', $command);
 
-$command = qq(perl lib/Vi/QuickFix.pm -q *ERRFILE* <infile) . REDIRECT;
+$command = qq($^X lib/Vi/QuickFix.pm -q *ERRFILE* <infile) . REDIRECT;
 run_tests( 'command_stdin', 'mine', $command);
 }}
 unlink 'infile', 'outfile';
 
-# do we catch all types of STDERR output?
+# do we catch (not catch) all types of STDERR output?
 use constant CASES => (
-    [ runtime_warning =>     'qq(a) + 0',         'Argument "a"' ],
-    [ runtime_error =>       'my %h = %{ []}',    'Can\'t coerce' ],
+    [ runtime_warning =>     '() = qq(a) + 0',    'Argument "a"' ],
+    [ runtime_error =>       'my %h = %{ \ 0 }',  'Not a HASH'   ],
     [ compiletime_warning => 'my @y; @y = @y[0]', 'Scalar value' ],
     [ compiletime_error =>   '%',                 'syntax error' ],
     [ explicit_warning =>    'warn qq(xxx)',      'xxx'          ],
     [ explicit_error =>      'die qq(yyy)',       'yyy'          ],
 );
-BEGIN { $n_tests += @{ [ CASES]} }
-{{
-for ( CASES ) {
-    my ( $case, $prog, $msg) = @$_;
-    unlink 'errors.err';
-    my $cmd = qq(perl -Ilib -MVi::QuickFix -we "$prog" ) . REDIRECT;
+BEGIN { $n_tests += 2*@{ [ CASES]} }
+{{
+for ( CASES ) {
+    my ( $case, $prog, $msg) = @$_;
+    unlink 'errors.err';
+    my $cmd = qq($^X -Ilib -MVi::QuickFix -we "$prog" ) . REDIRECT;
     system $cmd;
     like( read_errfile(), qr/^.*:\d+:$msg/, "$case message");
 }
+for ( CASES ) {
+    my ( $case, $prog, $msg) = @$_;
+    unlink 'errors.err';
+    my $cmd = qq($^X -Ilib -MVi::QuickFix -we "eval '$prog'" ) . REDIRECT;
+    system $cmd;
+    if ( $case =~ /_error$/ ) {
+        $msg = 'QuickFix .* active';
+        like( read_errfile(), qr/^.*:\d+:$msg/, "eval $case no message");
+    } else {
+        like( read_errfile(), qr/^.*:\d+:$msg/, "eval $case message");
+    }
+}
 }}
 
 # repeat these in "sig" mode, if both modes possible
-BEGIN { $n_tests += @{ [ CASES]} }
+BEGIN { $n_tests += 2*@{ [ CASES]} }
 SKIP: {{
-skip REASON_LOW, scalar @{ [ CASES]} if LOW_VERSION;
+skip REASON_LOW, scalar 2*@{ [ CASES]} if LOW_VERSION;
 for ( CASES ) {
     my ( $case, $prog, $msg) = @$_;
     unlink 'errors.err';
     my $cmd =
-        qq(perl -Ilib -MVi::QuickFix=sig -we "$prog" ) . REDIRECT;
+        qq($^X -Ilib -MVi::QuickFix=sig -we "$prog" ) . REDIRECT;
     system $cmd;
     like( read_errfile(), qr/^.*:\d+:$msg/, "$case(sig) message");
+}
+for ( CASES ) {
+    my ( $case, $prog, $msg) = @$_;
+    unlink 'errors.err';
+    my $cmd =
+        qq($^X -Ilib -MVi::QuickFix=sig -we "eval '$prog'" ) . REDIRECT;
+    system $cmd;
+    if ( $case =~ /_error$/ ) {
+        $msg = 'QuickFix .* active';
+        like( read_errfile(), qr/^.*:\d+:$msg/, "eval $case(sig) no message");
+    } else {
+        like( read_errfile(), qr/^.*:\d+:$msg/, "eval $case(sig) message");
+    }
+}
+}}
+
+# repeat these in "fork" mode
+BEGIN { $n_tests += 2*@{ [ CASES]} }
+SKIP: {{
+skip "'fork' mode currently not testable", 2*@{ [ CASES]};
+for ( CASES ) {
+    my ( $case, $prog, $msg) = @$_;
+    unlink 'errors.err';
+    my $cmd = qq($^X -Ilib -MVi::QuickFix=fork -we "$prog" ) . REDIRECT;
+    system $cmd;
+    like( read_errfile(), qr/^.*:\d+:$msg/, "$case(fork) message");
+}
+for ( CASES ) {
+    my ( $case, $prog, $msg) = @$_;
+    unlink 'errors.err';
+    my $cmd = qq($^X -Ilib -MVi::QuickFix=fork -we "eval '$prog'" ) . REDIRECT;
+    system $cmd;
+    if ( $case =~ /_error$/ ) {
+        $msg = 'QuickFix .* active';
+        like( read_errfile(), qr/^.*:\d+:$msg/, "eval $case(fork) no message");
+    } else {
+        like( read_errfile(), qr/^.*:\d+:$msg/, "eval $case(fork) message");
+    }
 }
 }}
 
@@ -160,36 +208,36 @@
 # do we get the obligatory warning?
 unlink 'errors.err';
 my $cmd =
-    qq(perl -Ilib -MVi::QuickFix -we "warn qq(abc)" ) . REDIRECT;
+    qq($^X -Ilib -MVi::QuickFix -we "warn qq(abc)" ) . REDIRECT;
 system $cmd;
 like( (read_errfile())[ -1],
     qr/QuickFix.*active/, "obligatory message found");
 
 # does silent mode work?
 unlink 'errors.err';
-system qq(perl -Ilib -MVi::QuickFix=silent -we 'warn "abc"' ) . REDIRECT;
+system qq($^X -Ilib -MVi::QuickFix=silent -we 'warn "abc"' ) . REDIRECT;
 unlike( (read_errfile())[ -1],
-    qr/Vi::QuickFix/, "silent mode message not found");
+    qr/QuickFix/, "silent mode message not found");
 
 # do we get only one obwarn when we fork?
 unlink 'errors.err';
-system qq(perl -Ilib -MVi::QuickFix -efork ) . REDIRECT;
+system qq($^X -Ilib -MVi::QuickFix -efork ) . REDIRECT;
 is( scalar( () = read_errfile()), 1, "fork one message");
 
 # do we not get it in exec mode?
 unlink 'errors.err';
-system qq(perl lib/Vi/QuickFix.pm <) . DEVNULL . ' ' . REDIRECT;
+system qq($^X lib/Vi/QuickFix.pm <) . DEVNULL . ' ' . REDIRECT;
 ok( not( -e 'errors.err'), "no message in exec mode");
 
 # is an empty error file removed (needs silent mode)?
-system qq(perl -Ilib -MVi::QuickFix -we ';' ) . REDIRECT; # create error file
+system qq($^X -Ilib -MVi::QuickFix -we ';' ) . REDIRECT; # create error file
 ok( -e 'errors.err', "Error file exists");
-system( qq(perl -Ilib -MVi::QuickFix=silent -we";"));
+system( qq($^X -Ilib -MVi::QuickFix=silent -we";"));
 ok( not( -e 'errors.err'), "Empty error file erased");
 
 # Does it behave under -c?
 unlink qw( stderr_out errors.err);
-system qq(perl -c -Ilib -we"use Vi::QuickFix" 2>stderr_out);
+system qq($^X -c -Ilib -we"use Vi::QuickFix" 2>stderr_out);
 is( -s( 'errors.err') || 0, 0, "-c: error file empty");
 like( read_errfile( 'stderr_out'), qr/^-e syntax OK/, "-c: -e syntax OK");
 unlink qw( stderr_out errors.err);
@@ -198,7 +246,7 @@
 ### environment variable VI_QUICKFIX_SOURCEFILE
 BEGIN { $n_tests += 2 }
 {{
-my $cmd = qq(perl -Ilib -MVi::QuickFix ) . REDIRECT;
+my $cmd = qq($^X -Ilib -MVi::QuickFix ) . REDIRECT;
 
 delete $ENV{ VI_QUICKFIX_SOURCEFILE};
 open my $p, '|-', $cmd;
@@ -219,8 +267,9 @@
 {{
 # unable to create error file
 require Vi::QuickFix;
-eval { Vi::QuickFix->import( 'gibsnich/wirdnix') };
-like( $@, qr/Can't create error file/, "Died without error file");
+local $SIG{__WARN__} = sub { die @_ };
+eval { Vi::QuickFix->import( 'tie', 'gibsnich/wirdnix') };
+like( $@, qr/Can't create error file/, "Warning without error file");
 
 SKIP: {
     skip "Can't be tested with perl $]", 3 if LOW_VERSION;
@@ -234,9 +283,9 @@
     untie *STDERR;
 
     # accept second use (no action then)
-    Vi::QuickFix->import( 'silent');
+    Vi::QuickFix->import( 'tie', 'silent');
     ok( tied *STDERR, 'Second use: STDERR is tied');
-    eval { Vi::QuickFix->import };
+    eval { Vi::QuickFix->import('tie') };
     like( $@, qr/^$/, 'Second use no error');
     untie *STDERR;
 }
@@ -276,7 +325,8 @@
 
 sub read_errfile {
     my $file = shift || 'errors.err';
-    open my( $e), $file or return;
+    
+    open my( $e), '<', $file or return '-';
     return join '', <$e> unless wantarray;
     return <$e>;
 }




More information about the Pkg-perl-cvs-commits mailing list