Consider this subroutine, which requires the user to enter a 4-digit number beginning with the numeral '4':

sub enter_number {
  local $_;
  while () {
    print "Enter new room number:  ";
    chomp ($_ = <STDIN>);
    if ($_ =~ /^4\d\d\d$/) {
      return $_;
    } else {
      print "\nMust be a 4-digit number beginning with '4'; try again.
+\n";
      next;
    }
  }
}
[download]

How would I test this routine using the standard Test::Harness/Test::Builder-based framework? Specifically, how would I have the test framework do something automatically at <STDIN> -- a place where the actual program pauses for user intervention?

I grepped the documentation for 'STDIN'. I googled comp.lang.perl.misc, c.l.p.modules and the perl.module-authors and perl.qa archives. I couldn't find an explicit solution.

I eventually formulated my problem as: ''I want to provide the subroutines with a list of arguments that will be processed as if they were being entered from <STDIN>. I want to tie an array holding that list to the STDIN filehandle.'' Once I had phrased it that way, I studied the section, ''Tying Filehandles'' in Chap. 14 of Programming Perl and wrote the following tie package:

package Preempt::Stdin;
use strict;

sub TIEHANDLE {
    my $class = shift;
    my @lines = @_;
    bless \@lines, $class;
}

sub READLINE {
    my $self = shift;
    shift @$self;
}

1;
[download]

I now can write a script which begins with the package above and proceeds as follows:

package main;
use strict;
use warnings;

my @lines = (
    'a string with numbers and letters 4678',
    '5678',
    '46789',
    ' 4678',
    '4678',
);

tie *STDIN, 'Preempt::Stdin', @lines;
my $room = enter_number();
untie *STDIN;
print "Room:  $room\n";
[download]

The script DWIMs. Instead of pausing for user intervention at the prompt, the script shifts elements off @lines and supplies them to enter_room() at <STDIN>. (You will note that I have first supplied four failing values before supplying a value that will succeed.)

How would this look in a testing context? Just throw in some standard code from Test::More.

package main;
use strict;
use warnings;
use Test::More tests => 2;

my @lines = (
    'a string with numbers and letters 4678',
    '5678',
    '46789',
    ' 4678',
    '4678',
);

tie *STDIN, 'Preempt::Stdin', @lines;
my $room;
ok($room = enter_number(), 'enter_number executed');
is(4678, $room, 'predicted value achieved');

untie *STDIN;
print "Room:  $room\n";

sub enter_number {
    local $_;
    while () {
        print "Enter new room number:  ";
        chomp ($_ = <STDIN>);
        if ($_ =~ /^4\d\d\d$/) {
            return $_;
        } else {
            print "\nMust be a 4-digit number beginning with '4'; try 
+again.\n";
            next;
        }
    }
}
[download]

But there are problems.

First, this doesn't work if I have used Perl's 'diamond' line-input operator <> instead of <STDIN>. Tying to STDIN appears to have no effect on the line-input operator; the line-input operator simply pauses and waits for input from the regular STDIN.

Second, if the code being tested calls for input from STDIN more times than there are elements in the array tied to STDIN (or if those elements are undef), and if the user prompt is located (as is likely) within a while (<>) loop, then the program goes into an infinite loop because all elements of the tied array have been shifted off.

So I pose this question to the monastery: Has anyone else come up with a better way to pre-empt STDIN for testing purposes?

Thanks in advance.

Jim Keenan