The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use lib '.','./t','./lib','../lib';
# can run from here or distribution base

use Test::More;
plan tests => 124;
## some online discussion of issues with use_ok, so just sanity check
cmp_ok($Test::Device::SerialPort::VERSION, '>=', 0.03, 'VERSION check');

# USB and virtual ports can't test output timing, first fail will set this
my $BUFFEROUT=0;

use Test::Device::SerialPort qw( :STAT 0.03 );

use strict;
use warnings;

my $file = "COM1";
my $cfgfile = "COM1_test.cfg";

my $ob;
my $in;
my $in2;
my $instead;
my @opts;
my $out;
my $blk;
my $err;
my $e;
my $tick;
my $tock;
my $patt;
my @necessary_param = Test::Device::SerialPort->set_test_mode_active(1);

# 2: Constructor

ok($ob = Test::Device::SerialPort->new ($file), "new $file");
die unless ($ob);    # next tests would die at runtime

#### 3 - 26: Check Port Initialization

is (scalar $ob->baudrate, 9600, 'baudrate init');
is (scalar $ob->parity, 'none', 'parity');
is (scalar $ob->handshake, 'none', 'handshake');
is (scalar $ob->databits, 8, 'databits');
is (scalar $ob->stopbits, 1, 'stopbits');
is (scalar $ob->user_msg, 0, 'user_msg');
is (scalar $ob->error_msg, 0, 'error_msg');
is ($ob->read_char_time, 0, 'read_char_time');
is ($ob->read_const_time, 0, 'read_const_time');
is (scalar $ob->debug, 0, 'debug');
is ($ob->set_no_random_data, 0, 'set_no_random_data');
is ($ob->device, ($^O eq "MSWin32") ? '\\\\.\\COM1' :'COM1', 'device');
is ($ob->alias, 'COM1', 'alias');
is ($ob->input, chr(0xa5), 'fake input');
is ($ob->binary, 1, 'binary');

($in, $out)= $ob->buffers();
is ($in, 4096, 'buffer in');
is ($out, 4096, 'buffer out');

### 27 - 65: Defaults for streamline and lookfor

is ($ob->set_no_random_data, 0, 'initial no_random_data');
ok ($ob->set_no_random_data(1), 'set no_random_data');
@opts = $ob->are_match;
is (scalar @opts, 1, 'are match');
is ($opts[0], "\n", 'new line as default');
is ($ob->lookclear, 1, 'lookclear');
is ($ob->lookfor, "", 'lookfor');
is ($ob->streamline, "", 'streamline');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "", 'input that MATCHED');
is ($out, "", 'input AFTER match');
is ($patt, "", 'PATTERN that matched');
is ($instead, "", 'input INSTEAD of matching');
is ($ob->matchclear, "", 'MATCH was first');

@opts = $ob->are_match ("END","Bye");
is ($#opts, 1, 'are_match');
is ($opts[0], "END", 'value=END');
is ($opts[1], "Bye", 'value = Bye');
is ($ob->lookclear("Good Bye, Hello"), 1, 'lookclear load data');
is ($ob->lookfor, "Good ", 'lookfor find match');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "Bye", 'MATCHED');
is ($out, ", Hello", 'AFTER');
is ($patt, "Bye", 'PATTERN');
is ($instead, "", 'INSTEAD');
is ($ob->matchclear, "Bye", 'what MATCHED');
is ($ob->matchclear, "", 'reset after reading');

is ($ob->lookclear("Bye, Bye, Love. The END has come"), 1, 'load new string');
is ($ob->lookfor, "", 'match at beginning');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "Bye", 'MATCHED');
is ($out, ", Bye, Love. The END has come", 'string AFTER');
is ($patt, "Bye", 'PATTERN');
is ($instead, "", 'INSTEAD');
is ($ob->matchclear, "Bye", 'what MATCHED');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "", 'matchclear');
is ($out, ", Bye, Love. The END has come", 'other lastlook retained');
is ($patt, "Bye", 'PATTERN');
is ($instead, "", 'INSTEAD');

is ($ob->lookfor, ", ", 'next string BEFORE match');
($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "Bye", 'MATCHED');
is ($out, ", Love. The END has come", 'string AFTER');
is ($patt, "Bye", 'PATTERN');
is ($instead, "", 'INSTEAD');
is ($ob->matchclear, "Bye", 'what MATCHED');

is ($ob->lookfor, ", Love. The ", 'next unmatched');
($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "END", 'MATCH other pattern');
is ($out, " has come", 'rest of string');
is ($patt, "END", 'other PATTERN');
is ($instead, "", 'INSTEAD');
is ($ob->matchclear, "END", 'matchclear');
is ($ob->lookfor, "", 'nothing else matched');
is ($ob->matchclear, "", 'not even at beginning');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "", 'no MATCH');
is ($patt, "", 'no PATTERN');
is ($instead, " has come", 'INSTEAD shows remainder');

is ($ob->lookclear("Good Bye, Hello"), 1, 'lookclear load for streamline');
is ($ob->streamline, "Good ", 'streamline');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "Bye", 'MATCHED');
is ($out, ", Hello", 'AFTER');
is ($patt, "Bye", 'PATTERN');
is ($instead, "", 'INSTEAD');
is ($ob->matchclear, "Bye", 'what MATCHED');
is ($ob->matchclear, "", 'reset after reading');

is ($ob->lookclear("First\nSecond\nThe END"), 1, 'lookclear load');
is ($ob->streamline, "First\nSecond\nThe ", 'streamline');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "END", 'MATCHED');
is ($out, "", 'nothing AFTER');
is ($patt, "END", 'PATTERN');
is ($instead, "", 'INSTEAD');

is ($ob->lookclear, 1, 'lookclear clears');
is ($ob->lookfor, "", 'check no data');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "", 'no MATCH');
is ($out, "", 'no AFTER');
is ($patt, "", 'no PATTERN');
is ($instead, "", 'NO INSTEAD');

@opts = $ob->are_match;
is ($#opts, 1, 'are_match');
is ($opts[0], "END", 'value=END');
is ($opts[1], "Bye", 'value = Bye');

@opts = $ob->are_match("\n");
is ($#opts, 0, 'are_match reset');
is ($opts[0], "\n", 'linefeed');

is ($ob->lookclear("Before\nAfter"), 1, 'lookclear load');
is ($ob->lookfor, "Before", 'lookfor match in middle');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "\n", 'MATCHED');
is ($out, "After", 'AFTER');
is ($patt, "\n", 'PATTERN');
is ($instead, "", 'INSTEAD');

is ($ob->lookfor, "", 'lookfor no match');
($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "", 'no MATCH');
is ($patt, "", 'no PATTERN');
is ($instead, "After", 'found AFTER');

@opts = $ob->are_match ("B*e","ab..ef","-re","12..56","END");
is ($#opts, 4, 're matches');
is ($opts[2], "-re", 're delimiter');
is ($ob->lookclear("Good Bye, the END, Hello"), 1, 'lookclear load');
is ($ob->lookfor, "Good Bye, the ", 'lookfor BEFORE');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "END", 'MATCHED');
is ($out, ", Hello", 'AFTER');
is ($patt, "END", 'PATTERN');
is ($instead, "", 'no INSTEAD');

is ($ob->lookclear("Good B*e, abcdef, 123456"), 1, 'lookclear load for re');
is ($ob->lookfor, "Good ", 'lookfor');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "B*e", 'wildcard MATCHED');
is ($out, ", abcdef, 123456", 'AFTER');
is ($patt, "B*e", 'PATTERN');
is ($instead, "", 'no INSTEAD');

is ($ob->lookfor, ", abcdef, ", 'lookfor');

($in, $out, $patt, $instead) = $ob->lastlook;
is ($in, "123456", 'MATCHED');
is ($out, "", 'nothing AFTER');
is ($patt, "12..56", 'PATTERN is re');
is ($instead, "", 'nothing INSTEAD');

undef $ob;