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