Various cleanups #3

Closed
wants to merge 20 commits into from
Jump to file
+303 −120
View
4 bin/trepanpl
@@ -2,7 +2,9 @@
# Standalone routine to invoke a Perl program under the debugger.
# The usual boilerplate...
-use strict; use warnings; use English;
+use strict;
+use warnings;
+use English qw( -no_match_vars );
use File::Basename; use File::Spec;
View
14 lib/Devel/Trepan/BrkptMgr.pm
@@ -1,10 +1,18 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rockyb@rubyforge.net>
-use strict; use warnings; no warnings 'redefine';
-use English;
+
+package Devel::Trepan::BrkptMgr;
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
+use English qw( -no_match_vars );
+
+# TODO : What is the meaning of this use lib? Can it be removed?
use lib '../..';
+
use Devel::Trepan::DB::Breakpoint;
-package Devel::Trepan::BrkptMgr;
sub new($$)
{
View
21 lib/Devel/Trepan/CmdProcessor.pm
@@ -1,13 +1,23 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
+package Devel::Trepan::CmdProcessor;
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
use feature ":5.10"; # Includes "state" feature.
-use Exporter;
use feature 'switch';
-use warnings; use strict;
+
+use English qw( -no_match_vars );
+
+use Exporter;
# Showing eval results can be done using either data dump package.
-require Data::Dumper; require Data::Dumper::Perltidy;
+require Data::Dumper;
+require Data::Dumper::Perltidy;
+# TODO : Shouldn't this use lib be removed?
use lib '../..';
require Devel::Trepan::BrkptMgr;
require Devel::Trepan::DB::Display;
@@ -23,12 +33,7 @@ require Devel::Trepan::CmdProcessor::Load unless
defined $Devel::Trepan::CmdProcessor::Load_seen;
require Devel::Trepan::CmdProcessor::Running;
require Devel::Trepan::CmdProcessor::Validate;
-use strict;
-use warnings;
-no warnings 'redefine';
-package Devel::Trepan::CmdProcessor;
-use English;
use Devel::Trepan::Util qw(hash_merge uniq_abbrev);
use vars qw(@EXPORT @ISA $eval_result);
View
2 lib/Devel/Trepan/CmdProcessor/Command/Action.pm
@@ -4,7 +4,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Action;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::Condition ;
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command ;
View
2 lib/Devel/Trepan/CmdProcessor/Command/Break.pm
@@ -6,7 +6,7 @@ use lib '../../../..';
# require_relative '../../app/condition'
package Devel::Trepan::CmdProcessor::Command::Break;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command;
unless (defined(@ISA)) {
eval "use constant ALIASES => qw(b);";
View
2 lib/Devel/Trepan/CmdProcessor/Command/Condition.pm
@@ -4,7 +4,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Condition;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::Condition ;
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command ;
View
2 lib/Devel/Trepan/CmdProcessor/Command/Delete.pm
@@ -4,7 +4,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Delete;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command ;
View
2 lib/Devel/Trepan/CmdProcessor/Command/Display.pm
@@ -4,7 +4,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Display;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::DB::Display ;
use if !defined @ISA, Devel::Trepan::Condition ;
View
2 lib/Devel/Trepan/CmdProcessor/Command/List.pm
@@ -6,7 +6,7 @@ use lib '../../../..';
# require_relative '../../app/condition'
package Devel::Trepan::CmdProcessor::Command::List;
-use English;
+use English qw( -no_match_vars );
use Devel::Trepan::DB::LineCache;
use Devel::Trepan::CmdProcessor::Validate;
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command;
View
2 lib/Devel/Trepan/CmdProcessor/Command/Macro.pm
@@ -5,7 +5,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Macro;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command ;
unless (defined(@ISA)) {
eval "use constant CATEGORY => 'support';";
View
2 lib/Devel/Trepan/CmdProcessor/Command/Restart.pm
@@ -5,7 +5,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Restart;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command ;
unless (defined(@ISA)) {
View
2 lib/Devel/Trepan/CmdProcessor/Command/Undisplay.pm
@@ -4,7 +4,7 @@ use warnings; no warnings 'redefine';
use lib '../../../..';
package Devel::Trepan::CmdProcessor::Command::Undisplay;
-use English;
+use English qw( -no_match_vars );
use if !defined @ISA, Devel::Trepan::CmdProcessor::Command ;
View
11 lib/Devel/Trepan/CmdProcessor/Frame.pm
@@ -1,12 +1,17 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
-use strict; use warnings;
+
+package Devel::Trepan::CmdProcessor;
+
+use strict;
+use warnings;
+
+# TODO : I don't think this use lib is a good idea.
use lib '../../..';
use Devel::Trepan::DB::Sub;
use Devel::Trepan::Complete;
-package Devel::Trepan::CmdProcessor;
-use English;
+use English qw( -no_match_vars );
sub adjust_frame($$$)
{
View
8 lib/Devel/Trepan/CmdProcessor/Hook.pm
@@ -1,6 +1,11 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
-use strict; use warnings;
+package Devel::Trepan::CmdProcessor::Hook;
+
+use strict;
+use warnings;
+
+# TODO : I don't think this lib is a good idea.
use lib '../../..';
use Class::Struct;
@@ -13,7 +18,6 @@ struct CmdProcessorHook => {
};
-package Devel::Trepan::CmdProcessor::Hook;
# attr_accessor :list
sub new($;$)
View
2 lib/Devel/Trepan/CmdProcessor/Location.pm
@@ -7,7 +7,7 @@ use lib '../../..';
# require_relative '../app/default'
package Devel::Trepan::CmdProcessor;
-use English;
+use English qw( -no_match_vars );
use Cwd 'abs_path';
use File::Basename;
View
11 lib/Devel/Trepan/CmdProcessor/Running.pm
@@ -1,15 +1,16 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
-use strict; use warnings;
+package Devel::Trepan::CmdProcessor;
+use strict;
+use warnings;
use feature 'switch';
+
+# TODO : I don't think this use lib is a good idea.
use lib '../../..';
use Devel::Trepan::Position;
-package Devel::Trepan::CmdProcessor;
-use English;
-
-
+use English qw( -no_match_vars );
# attr_accessor :stop_condition # String or nil. When not nil
# # this has to eval non-nil
View
11 lib/Devel/Trepan/CmdProcessor/Validate.pm
@@ -3,13 +3,16 @@
# Trepan command input validation routines. A String type is
# usually passed in as the argument to validation routines.
-use strict; use warnings;
-use Exporter;
+package Devel::Trepan::CmdProcessor;
+use strict;
+use warnings;
use feature 'switch';
-use lib '../../..';
-package Devel::Trepan::CmdProcessor;
+use Exporter;
+
+# TODO : I don't think this use lib is a good idea.
+use lib '../../..';
use Cwd 'abs_path';
use Devel::Trepan::DB::Breakpoint;
View
8 lib/Devel/Trepan/Condition.pm
@@ -1,8 +1,12 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
-use strict; use warnings;
+
package Devel::Trepan::Condition;
-use English;
+
+use strict;
+use warnings;
+use English qw( -no_match_vars );
+
use vars qw(@EXPORT @ISA);
@EXPORT = qw( is_valid_condition );
@ISA = qw(Exporter);
View
6 lib/Devel/Trepan/DB.pm
@@ -9,7 +9,7 @@ use lib '../..';
package DB;
use feature 'switch';
use warnings; no warnings 'redefine';
-use English;
+use English qw( -no_match_vars );
use vars qw($usrctxt $running $caller
$event @ret $ret $return_value @return_value
@@ -87,11 +87,11 @@ BEGIN {
require threads;
require threads::shared;
import threads::shared qw(share);
- no strict; no warnings;
+ no strict;
+ no warnings;
$DBGR;
share(\$DBGR);
lock($DBGR);
- use strict; use warnings;
print "Thread support enabled\n";
} else {
*lock = sub(*) {};
View
2 lib/Devel/Trepan/DB/Backtrace.pm
@@ -1,6 +1,6 @@
package DB;
use warnings; no warnings 'redefine';
-use English;
+use English qw( -no_match_vars );
=head2 backtrace(skip[,count,scan_for_DB])
View
9 lib/Devel/Trepan/DB/Breakpoint.pm
@@ -39,9 +39,14 @@ sub icon_char($)
}
package DB;
+
use vars qw($brkpt $package $lineno $max_bp $max_action);
-use strict; use warnings; no warnings 'redefine';
-use English;
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
+use English qw( -no_match_vars );
BEGIN {
$DB::brkpt = undef; # current breakpoint
View
9 lib/Devel/Trepan/DB/Display.pm
@@ -1,12 +1,15 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rockyb@rubyforge.net>
# FIXME: Could combine manager code from breakpoints and display
-use strict; use warnings; no warnings 'redefine';
-use English;
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
+use English qw( -no_match_vars );
use lib '../..';
use Class::Struct;
-use strict;
struct DBDisplay => {
number => '$', # breakpoint/action number
View
11 lib/Devel/Trepan/DB/Eval.pm
@@ -1,11 +1,15 @@
# Eval part of Perl's Core DB.pm library and perl5db.pl with modification.
+# TODO : Shouldn't this use lib be removed?
use lib '../..';
package DB;
-use warnings; use strict;
-use English;
+
+use warnings;
+use strict;
use feature 'switch';
+
+use English qw( -no_match_vars );
use vars qw($eval_result @eval_result %eval_result
$eval_str $eval_opts $event $return_type );
@@ -30,7 +34,8 @@ sub eval {
$OUTPUT_FIELD_SEPARATOR,
$INPUT_RECORD_SEPARATOR,
$OUTPUT_RECORD_SEPARATOR, $WARNING) = @saved;
- no strict; no warnings;
+ no strict;
+ no warnings;
eval "$user_context $eval_str; &DB::save\n"; # '\n' for nice recursive debug
_warnall($@) if $@;
}
View
15 lib/Devel/Trepan/DB/LineCache.pm
@@ -39,11 +39,14 @@ use version; $VERSION = '0.1.0';
# A package to read and cache lines of a Perl program.
package DB::LineCache;
-use English;
-use strict; use warnings;
+
+use strict;
+use warnings;
no warnings 'once';
no warnings 'redefine';
+use English qw( -no_match_vars );
+
use Cwd 'abs_path';
use File::Basename;
use File::Spec;
@@ -562,12 +565,14 @@ sub update_cache($;$)
$lines_href->{plain} = $raw_lines;
if ($opts->{output} && defined($raw_lines)) {
# Some lines in $raw_lines may be undefined
- no strict; no warnings;
+ no strict;
+ no warnings;
local $WARNING=0;
my $highlight_lines = highlight_string(join('', @$raw_lines));
my @highlight_lines = split(/\n/, $highlight_lines);
$lines_href->{$opts->{output}} = \@highlight_lines;
- use strict; use warnings;
+ use strict;
+ use warnings;
}
my $entry = {
stat => $stat,
@@ -618,7 +623,7 @@ sub update_cache($;$)
# example usage
unless (caller) {
BEGIN {
- use English;
+ use English qw( -no_match_vars );
$PERLDB |= 0x400;
}; # Turn on saving @{_<$filename};
my $file=__FILE__;
View
2 lib/Devel/Trepan/DB/Sub.pm
@@ -4,7 +4,7 @@
package DB;
use warnings; no warnings 'redefine';
no warnings 'once';
-use English;
+use English qw( -no_match_vars );
use constant SINGLE_STEPPING_EVENT => 1;
use constant DEEP_RECURSION_EVENT => 4;
View
8 lib/Devel/Trepan/IO.pm
@@ -10,12 +10,14 @@
# Some ideas originiated as part of Matt Fleming's 2006 Google Summer of
# Code project.
-use strict; use warnings;
+package Devel::Trepan::IO::InputBase;
+
+use strict;
+use warnings;
+
use Exporter;
use lib '../..';
-package Devel::Trepan::IO::InputBase;
-
use Devel::Trepan::Util qw(hash_merge);
use vars qw(@EXPORT);
View
6 lib/Devel/Trepan/IO/Input.pm
@@ -5,12 +5,14 @@
# input or GNU Readline.
#
-use warnings; use strict;
+package Devel::Trepan::IO::Input;
+use warnings;
+use strict;
use Exporter;
use Term::ReadLine;
-package Devel::Trepan::IO::Input;
+# TODO : Shouldn't this use lib be removed?
use lib '../../..';
use Devel::Trepan::Util qw(hash_merge);
use Devel::Trepan::IO;
View
5 lib/Devel/Trepan/IO/StringArray.pm
@@ -4,8 +4,11 @@
# Simulate I/O using lists of strings.
package Devel::Trepan::IO::StringArrayInput;
-use warnings; use strict;
+use warnings;
+use strict;
+
+# TODO : Shouldn't this use lib be removed?
use lib '../../..';
use Devel::Trepan::IO;
View
8 lib/Devel/Trepan/Interface/Script.pm
@@ -2,12 +2,16 @@
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
# Module for reading debugger scripts
+package Devel::Trepan::Interface::Script;
+
+use strict;
+use warnings;
+no warnings 'redefine';
-use warnings; no warnings 'redefine'; use strict;
use Exporter;
use IO::File;
-package Devel::Trepan::Interface::Script;
+# TODO : Shouldn't this use lib be removed?
use lib '../../..';
use Devel::Trepan::Interface;
use Devel::Trepan::IO::Input;
View
9 lib/Devel/Trepan/Interface/User.pm
@@ -3,10 +3,15 @@
# Interface when communicating with the user.
-use warnings; no warnings 'once'; use strict;
+package Devel::Trepan::Interface::User;
+
+use strict;
+use warnings;
+no warnings 'once';
+
use Exporter;
-package Devel::Trepan::Interface::User;
+# TODO : Shouldn't this use lib be removed?
use lib '../../..';
use vars qw(@EXPORT @ISA $HAVE_READLINE);
@ISA = qw(Devel::Trepan::Interface Exporter);
View
3 lib/Devel/Trepan/Position.pm
@@ -1,4 +1,5 @@
-use strict; use warnings;
+use strict;
+use warnings;
use Class::Struct;
struct TrepanPosition => {pkg => '$', filename => '$', line => '$',
View
9 lib/Devel/Trepan/Util.pm
@@ -1,8 +1,11 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
-use strict; use warnings;
-use feature 'switch';
package Devel::Trepan::Util;
+
+use strict;
+use warnings;
+use feature 'switch';
+
use vars qw(@EXPORT @ISA);
@EXPORT = qw( hash_merge safe_repr uniq_abbrev extract_expression
parse_eval_suffix);
@@ -125,7 +128,7 @@ unless (caller) {
print extract_expression($stmt), "\n";
}
- for my $cmd qw(eval eval$ eval% eval@ evaluate% none) {
+ for my $cmd (qw(eval eval$ eval% eval@ evaluate% none)) {
printf "parse_eval_suffix($cmd) => '%s'\n", parse_eval_suffix($cmd);
}
}
View
2 t/10test-db-brkpt.t
@@ -7,7 +7,7 @@ use Test::More 'no_plan';
note( "Testing Devel::Trepan::DB::Breakpoint" );
BEGIN {
- use English;
+ use English qw( -no_match_vars );
$PERLDB |= 0x400;
use_ok( 'Devel::Trepan::DB::Breakpoint' );
}
View
7 t/10test-intf-user.t
@@ -1,5 +1,10 @@
#!/usr/bin/env perl
-use strict; use warnings; no warnings 'redefine';
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
+# TODO : What is the meaning of this use lib? Can it be removed?
use lib '../lib';
use vars qw($response);
View
8 t/10test-linecache.t
@@ -1,12 +1,16 @@
#!/usr/bin/env perl
-use strict; use warnings;
+
+use strict;
+use warnings;
+
+# TODO : What is the meaning of this use lib? Can it be removed?
use lib '../lib';
use Test::More 'no_plan';
note( "Testing Devel::Trepan::DB::LineCache" );
BEGIN {
- use English;
+ use English qw( -no_match_vars );
$PERLDB |= 0x400;
use_ok( 'Devel::Trepan::DB::LineCache' );
}
View
6 t/10test-options.t
@@ -1,5 +1,9 @@
#!/usr/bin/env perl
-use strict; use warnings; use English;
+
+use strict;
+use warnings;
+use English qw( -no_match_vars );
+
use lib '../lib';
use Test::More 'no_plan';
View
7 t/10test-proc-hook.t
@@ -1,5 +1,10 @@
#!/usr/bin/env perl
-use strict; use warnings; no warnings 'redefine';
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
+# TODO : I don't think this use lib is a good idea.
use lib '../lib';
use vars qw(@args);
View
8 t/10test-proc-load.t
@@ -1,6 +1,12 @@
#!/usr/bin/env perl
-use strict; use warnings; no warnings 'redefine';
+
+use strict;
+use warnings;
+no warnings 'redefine';
+
+# TODO : I don't think this use lib is a good idea.
use lib '../lib';
+
use vars qw($response);
use Test::More 'no_plan';
View
8 t/20test-autolist.t
@@ -1,6 +1,10 @@
#!/usr/bin/env perl
-use warnings; use strict;
-use File::Basename; use File::Spec;
+
+use warnings;
+use strict;
+
+use File::Basename;
+use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
use Helper;
View
5 t/20test-break.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Spec;
use File::Basename qw(dirname);
use lib dirname(__FILE__);
View
5 t/20test-display.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Spec;
use File::Basename qw(dirname);
use lib dirname(__FILE__);
View
8 t/20test-eval.t
@@ -1,6 +1,10 @@
#!/usr/bin/env perl
-use warnings; use strict;
-use File::Basename; use File::Spec;
+
+use warnings;
+use strict;
+
+use File::Basename;
+use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
use Helper;
View
5 t/20test-list1.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Basename; use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
View
5 t/20test-list2.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Basename; use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
View
5 t/20test-list3.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Basename; use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
View
5 t/20test-next.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Basename; use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
View
5 t/20test-seq1.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Spec;
use File::Basename qw(dirname);
use lib dirname(__FILE__);
View
8 t/20test-step.t
@@ -1,6 +1,10 @@
#!/usr/bin/env perl
-use warnings; use strict;
-use File::Basename; use File::Spec;
+
+use warnings;
+use strict;
+
+use File::Basename;
+use File::Spec;
use Test::More 'no_plan';
use lib dirname(__FILE__);
use Helper;
View
5 t/20test-trace.t
@@ -1,5 +1,8 @@
#!/usr/bin/env perl
-use warnings; use strict;
+
+use warnings;
+use strict;
+
use File::Spec;
use File::Basename qw(dirname);
use lib dirname(__FILE__);
View
7 t/20test-trepanpl-opts.t
@@ -1,7 +1,10 @@
#!/usr/bin/env perl
+
use strict;
-use warnings; use strict;
-use English;
+use warnings;
+
+use English qw( -no_match_vars );
+
use File::Basename;
use File::Spec;
my $trepanpl = File::Spec->catfile(dirname(__FILE__), qw(.. bin trepanpl));
View
104 t/Helper.pm
@@ -1,45 +1,95 @@
-use warnings; use strict;
+package Helper;
+
+use warnings;
+use strict;
+
use String::Diff;
+use File::Basename qw(dirname);
use File::Spec;
-use File::Basename;
+
+use English qw( -no_match_vars ) ;
+
+require Test::More;
+
my $trepanpl = File::Spec->catfile(dirname(__FILE__), qw(.. bin trepanpl));
my $debug = $^W;
-package Helper;
-use File::Basename qw(dirname); use File::Spec;
-use English;
-require Test::More;
+sub _slurp
+{
+ my ($filename) = @_;
+
+ open my $in, '<', $filename
+ or die "Cannot open '$filename' for slurping - $!";
+
+ local $/;
+ my $contents = <$in>;
+
+ close($in);
+
+ return $contents;
+}
+
sub run_debugger($$;$$)
{
- my ($test_invoke, $cmdfile, $rightfile, $opts) = @_;
+ my ($test_invoke, $cmd_fn, $right_fn, $opts) = @_;
+
$opts //= {};
- Test::More::note( "running $test_invoke with $cmdfile" );
+
+ Test::More::note( "running $test_invoke with $cmd_fn" );
+
my $run_opts = $opts->{run_opts} || "--basename --nx --no-highlight";
- my $full_cmdfile = File::Spec->catfile(dirname(__FILE__), 'data', $cmdfile);
- $run_opts .= " --command $full_cmdfile" unless ($opts->{no_cmdfile});
- ($rightfile = $full_cmdfile) =~ s/\.cmd/.right/ unless defined($rightfile);
+ my $full_cmd_fn = File::Spec->catfile(dirname(__FILE__), 'data', $cmd_fn);
+ my $ext_filename = sub {
+ my ($ext) = @_;
+
+ my $new_fn = $full_cmd_fn;
+
+ $new_fn =~ s/\.cmd\z/.$ext/;
+
+ return $new_fn;
+ };
+
+ $run_opts .= " --command $full_cmd_fn" unless ($opts->{no_cmdfile});
+
+ if (!defined($right_fn))
+ {
+ $right_fn = $ext_filename->('right');
+ }
+
my $cmd = "$EXECUTABLE_NAME $trepanpl $run_opts $test_invoke";
print $cmd, "\n" if $debug;
+
my $output = `$cmd`;
- print $output if $debug;
my $rc = $? >> 8;
- Test::More::is($rc, 0);
- open(RIGHT_FH, "<$rightfile");
- undef $INPUT_RECORD_SEPARATOR;
- my $right_string = <RIGHT_FH>;
- ($output, $right_string) = $opts->{filter}->($output, $right_string) if $opts->{filter};
- my $gotfile;
- ($gotfile = $full_cmdfile) =~ s/\.cmd/.got/;
- if ($right_string eq $output) {
- Test::More::ok(1);
- unlink $gotfile;
+
+ print $output if $debug;
+ Test::More::is($rc, 0, 'Debugger command was executed successfully');
+
+ my $right_string = _slurp($right_fn);
+
+ if ($opts->{filter})
+ {
+ ($output, $right_string) = $opts->{filter}->($output, $right_string);
+ }
+
+ my $got_fn = $ext_filename->('got');
+
+ # TODO : Perhaps make sure we optionally use eq_or_diff from
+ # Test::Differences here.
+ if (Test::More::is($right_string, $output, 'Output comparison')) {
+ unlink $got_fn;
} else {
- my $diff = String::Diff::diff_merge($output, $right_string);
- open(GOT_FH, ">$gotfile");
- print GOT_FH $output;
- print $diff;
- Test::More::ok(0, "Output comparison fails");
+ my $diff = String::Diff::diff_merge($output, $right_string);
+
+ open (my $got_fh, '>', $got_fn)
+ or die "Cannot open '$got_fn' for writing - $!";
+ print {$got_fh} $output;
+ close($got_fh);
+
+ Test::More::diag($diff);
}
+
+ return;
}
1;