#! /usr/bin/perl -w
# Give an argument to use stdin, stdout instead of console
# If argument starts with /dev, use it as console
# If argument is '--no-print', do not print the result.
use warnings; use strict;
use rlib './lib';
BEGIN{
# Do not test TR::Gnu !
$ENV{PERL_RL} = 'Perl5';
$ENV{'INPUTRC'} = '/dev/null';
$ENV{'COLUMNS'} = '80';
$ENV{'LINES'} = '25';
};
use lib './lib';
# FIXME:
# Until Term::ReadLine has Perl5 defined use
# Term::ReadLine::Perl5 ?
use Term::ReadLine::Perl5;
use Carp;
$SIG{__WARN__} = sub { warn Carp::longmess(@_) };
my $non_interactive =
(defined($ENV{PERL_MM_NONINTERACTIVE}))
? $ENV{PERL_MM_NONINTERACTIVE} :
($ENV{PERL_MM_USE_DEFAULT} || $ENV{AUTOMATED_TESTING});
if ($non_interactive) {
no strict; no warnings;
print "1..0 # skip: not interactive; " .
"\$ENV{PERL_MM_NONINTERACTIVE}='$ENV{PERL_MM_NONINTERCTIVE}' \$ENV{AUTOMATED_TESTING}='$ENV{AUTOMATED_TESTING}'\n";
exit;
}
my ($term, $no_print);
if (!@ARGV) {
$term = new Term::ReadLine::Perl5 'Simple Perl calc';
} elsif (@ARGV == 2) {
open(IN,"<$ARGV[0]");
open(OUT,">$ARGV[1]");
$term = new Term::ReadLine::Perl5 'Simple Perl calc', \*IN, \*OUT;
} elsif ($ARGV[0] =~ m|^/dev|) {
open(IN,"<$ARGV[0]");
open(OUT,">$ARGV[0]");
$term = new Term::ReadLine::Perl5 'Simple Perl calc', \*IN, \*OUT;
} else {
$term = new Term::ReadLine::Perl5 'Simple Perl calc', \*STDIN, \*STDOUT;
$no_print = $ARGV[0] eq '--no-print';
}
my $prompt = "Enter arithmetic or Perl expression: ";
if ((my $l = $ENV{PERL_RL_TEST_PROMPT_MINLEN} || 0) > length $prompt) {
$prompt =~ s/(?=:)/ ' ' x ($l - length $prompt)/e;
}
print "1..1\n";
no strict;
my $OUT = $term->OUT || \*STDOUT;
use strict;
my %features = %{ $term->Features };
if (%features) {
my @f = %features;
print $OUT "Features present: @f\n";
#$term->ornaments(1) if $features{ornaments};
} else {
print $OUT "No additional features present.\n";
}
print $OUT "\n Flipping rl_default_selected each line.\n";
print $OUT <<EOP;
Hint: Entering the word
exit
would exit the test. ;-) (If feature 'preput' is present,
this word should be already entered.)
EOP
while ( defined (my $line = $term->readline($prompt, 'exit')) )
{
last if $line eq 'exit';
my $res = eval($line);
warn $@ if $@;
if (!defined $res) {
print $OUT "undef\n";
next;
}
print $OUT $res, "\n" unless $@ or $no_print;
$term->addhistory($line) if $line =~ /\S/ and !$features{autohistory};
$readline::rl_default_selected = !$readline::rl_default_selected;
}
print "ok 1\n";