t/test1.t - metacpan.org

use lib '.','./t','./lib','../lib';
# can run from here or distribution base

use Test::More;
### use Data::Dumper;
eval "use DefaultPort;";
if ($@) {
    plan skip_all => 'No serial port selected for use with testing';
}
else {
    plan tests => 309;
}
cmp_ok($Win32::SerialPort::VERSION, '>=', 0.20, 'VERSION check');

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

use Win32::SerialPort qw( :STAT 0.20 );

use strict;
use warnings;

## verifies the (0, 1) list returned by binary functions
sub test_bin_list {
    return undef unless (@_ == 2);
    return undef unless (0 == shift);
    return undef unless (1 == shift);
    return 1;
}

## verifies the (0, 255) list returned by byte functions
sub test_byte_list {
    return undef unless (@_ == 2);
    return undef unless (0 == shift);
    return undef unless (255 == shift);
    return 1;
}

## verifies the (0, 0xffff) list returned by short functions
sub test_short_list {
    return undef unless (@_ == 2);
    return undef unless (0 == shift);
    return undef unless (0xffff == shift);
    return 1;
}

## verifies the (0, 0xffffffff) list returned by long functions
sub test_long_list {
    return undef unless (@_ == 2);
    return undef unless (0 == shift);
    return undef unless (0xffffffff == shift);
    return 1;
}

## verifies the value returned by byte functions
sub test_byte_value {
    my $v = shift;
    return undef if (($v < 0) or ($v > 255));
    return 1;
}

sub is_bad {
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    return ok(!shift, shift);
}

my $file = "COM1";
if ($SerialJunk::Makefile_Test_Port) {
    $file = $SerialJunk::Makefile_Test_Port;
}
if (exists $ENV{Makefile_Test_Port}) {
    $file = $ENV{Makefile_Test_Port};
}

if (@ARGV) {
    $file = shift @ARGV;
}
my $cfgfile = $file."_test.cfg";

my $fault = 0;
my $ob;
my $pass;
my $fail;
my $in;
my $in2;
my @opts;
my $out;
my $err;
my $blk;
my $e;
my $s="testing is a wonderful thing - this is a 60 byte long string";
#      123456789012345678901234567890123456789012345678901234567890
my $line = $s.$s.$s;		# about 185 MS at 9600 baud
my $tick;
my $tock;
my %required_param;
my @necessary_param = Win32::SerialPort->set_test_mode_active(1);

unlink $cfgfile;
foreach $e (@necessary_param) { $required_param{$e} = 0; }

## 2 - 6 SerialPort Global variable ($Babble);

is_bad(scalar Win32::SerialPort::debug, 'no debug init');
ok(scalar Win32::SerialPort::debug(1), 'set debug');
is_bad(scalar Win32::SerialPort::debug(2), 'invalid set debug');
ok(scalar Win32::SerialPort->debug(1), 'set debug');
ok(scalar Win32::SerialPort::debug(), 'read debug state');

# 7 - 20: yes_true subroutine, no need to SHOUT if it works

ok( Win32::SerialPort::debug("T"), 'yes_true() tests = T' );
ok( !Win32::SerialPort::debug("F"), 'F');

{
    no strict 'subs';
    ok( Win32::SerialPort::debug(T), 'T');
    ok(!Win32::SerialPort::debug(F), 'F');
    ok( Win32::SerialPort::debug(Y), 'Y');
    ok(!Win32::SerialPort::debug(N), 'N');
    ok( Win32::SerialPort::debug(ON), 'ON');
    ok(!Win32::SerialPort::debug(OFF), 'OFF');
    ok( Win32::SerialPort::debug(TRUE), 'TRUE');
    ok(!Win32::SerialPort::debug(FALSE), 'FALSE');
    ok( Win32::SerialPort::debug(Yes), 'Yes');
    ok(!Win32::SerialPort::debug(No), 'No');
    ok( Win32::SerialPort::debug("yes"), 'yes');
    ok(!Win32::SerialPort::debug("f"), 'f');
}

@opts = Win32::SerialPort::debug();
ok(test_bin_list(@opts), 'binary_opt_array');

# 21: Constructor

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

#### 22 - 41: Check Port Capabilities 

ok($ob->can_baud, 'can_baud');
ok($ob->can_databits, 'can_databits');
ok($ob->can_stopbits, 'can_stopbits');
ok($ob->can_dtrdsr, 'can_dtrdsr');
ok($ob->can_handshake, 'can_handshake');
ok($ob->can_parity_check, 'can_parity_check');
ok($ob->can_parity_config, 'can_parity_config');
ok($ob->can_parity_enable, 'can_parity_enable');
ok($ob->can_rtscts, 'can_ctsrts');
ok($ob->can_rlsd, 'can_rlsd');
ok($ob->can_xonxoff, 'can_xonxoff');
ok($ob->can_interval_timeout, 'can_interval_timeout');
ok($ob->can_total_timeout, 'can_total_timeout');
ok($ob->can_xon_char, 'can_xon_char');
ok($ob->is_rs232, 'is_rs232');

is($ob->can_spec_char, 0, 'can_spec_char');
is($ob->can_ioctl, 0, 'can_ioctl');
is($ob->can_16bitmode, 0, 'can_16bitmode');
is_bad($ob->is_modem, 'is_modem');

## 42 - 61: Byte Capabilities

$in = $ob->xon_char;
ok(test_byte_value($in), 'xon_char value');
is_bad(scalar $ob->xon_char(500), 'byte limit');
@opts = $ob->xon_char;
ok(test_byte_list(@opts), 'xon_char range');
ok(scalar $ob->xon_char(0x11), 'set xon_char');

$in = $ob->xoff_char;
ok(test_byte_value($in), 'xoff_char value');
is_bad(scalar $ob->xoff_char(-1), 'byte limit');
@opts = $ob->xoff_char;
ok(test_byte_list(@opts), 'xoff_char range');
ok(scalar $ob->xoff_char(0x13), 'set xoff_char');

$in = $ob->eof_char;
ok(test_byte_value($in), 'eof_char value');
is_bad(scalar $ob->eof_char(500), 'byte limit');
@opts = $ob->eof_char;
ok(test_byte_list(@opts), 'eof_char range');
is(scalar $ob->eof_char(0), 0, 'set eof_char');

$in = $ob->event_char;
ok(test_byte_value($in), 'event_char value');
is_bad(scalar $ob->event_char(5000), 'byte limit');
@opts = $ob->event_char;
ok(test_byte_list(@opts), 'event_char range');
is(scalar $ob->event_char(0), 0, 'set event_char');

$in = $ob->error_char;
ok(test_byte_value($in), 'error_char value');
is_bad(scalar $ob->error_char(65600), 'byte limit');
@opts = $ob->error_char;
ok(test_byte_list(@opts), 'error_char range');
is(scalar $ob->error_char(0), 0, 'set error_char');

#### 62 - 92: Set Basic Port Parameters 

## 62 - 67: Baud (Valid/Invalid/Current)

@opts=$ob->baudrate;		# list of allowed values
ok(1 == grep(/^9600$/, @opts), '9600 baud in list');
ok(0 == grep(/^9601/, @opts), '9601 baud not in list'); # force scalar context

ok($in = $ob->baudrate, 'read baudrate');
ok(1 == grep(/^$in$/, @opts), "confirm $in in baud array");
is_bad(scalar $ob->baudrate(9601), 'cannot set 9601 baud');
ok($ob->baudrate(9600), 'can set 9600 baud');
    # leaves 9600 pending

## 68 - 73: Parity (Valid/Invalid/Current)

@opts=$ob->parity;		# list of allowed values
ok(1 == grep(/none/, @opts), 'parity none in list');
ok(0 == grep(/any/, @opts), 'parity any not in list');

ok($in = $ob->parity, 'read parity');
ok(1 == grep(/^$in$/, @opts), "confirm $in in parity array");

is_bad(scalar $ob->parity("any"), 'cannot set any parity');
ok($ob->parity("none"), 'can set none parity');
    # leaves "none" pending

## 74: Missing Param test

is_bad(scalar $ob->write_settings, 'write_settings prerequisites');

## 75 - 80- Databits (Valid/Invalid/Current)

@opts=$ob->databits;		# list of allowed values
ok(1 == grep(/8/, @opts), '8 databits in list');
ok(0 ==  grep(/4/, @opts), '4 databits not in list');

ok($in = $ob->databits, 'read databits');
ok(1 == grep(/^$in$/, @opts), 'confirm $in databits in list');

is_bad(scalar $ob->databits(3), 'cannot set 3 databits');
ok($ob->databits(8), 'can set 8 databits');
    # leaves 8 pending

## 81 - 86: Stopbits (Valid/Invalid/Current)

@opts=$ob->stopbits;		# list of allowed values
ok(1 == grep(/2/, @opts), '2 stopbits in list');
ok(0 == grep(/2.5/, @opts), '2.5 stopbits not in list');

ok($in = $ob->stopbits, 'read stopbits');
ok(1 == grep(/^$in$/, @opts), "confirm $in stopbits in list");

is_bad(scalar $ob->stopbits(3), 'cannot set 3 stopbits');
ok($ob->stopbits(1), 'can set 1 stopbit');
    # leaves 1 pending

## 87 - 92: Handshake (Valid/Invalid/Current)

@opts=$ob->handshake;		# list of allowed values
ok(1 == grep(/none/, @opts), 'handshake none in list');
ok(0 ==  grep(/moo/, @opts), 'handshake moo not in list');

ok($in = $ob->handshake, 'read handshake');
ok(1 == grep(/^$in$/, @opts), "confirm handshake $in in list");

is_bad(scalar $ob->handshake("moo"), 'cannot set handshake moo');
ok($ob->handshake("rts"), 'can set handshake rts');

## 93 - 99: Buffer Size

($in, $out) = $ob->buffer_max(512);
is_bad(defined $in, 'invalid buffer_max command');
($in, $out) = $ob->buffer_max;
ok(defined $in, 'read in buffer_max');
ok(defined $out, 'read out buffer_max');

if (($in > 0) and ($in < 4096))		{ $in2 = $in; } 
else					{ $in2 = 4096; }

if (($out > 0) and ($out < 4096))	{ $err = $out; } 
else					{ $err = 4096; }

ok(scalar $ob->buffers($in2, $err), 'valid set buffer_max');

@opts = $ob->buffers(4096, 4096, 4096);
is_bad(defined $opts[0], 'invalid buffers command');
($in, $out)= $ob->buffers;
ok($in2 == $in, 'check buffers in setting');
ok($out == $err, 'check buffers out setting');

## 100 - 102: Alias and Device

is($ob->alias, $file, 'original alias from new');
is($ob->alias("TestPort"), 'TestPort', 'set alias');
if ($file =~ /^COM\d+$/io) {
	is($ob->device, '\\\\.\\'.$file, 'device from new');
} else {
	is($ob->device, $file, 'original device from new');
}

## 103 - 108: Read Timeouts

@opts = $ob->read_interval;
ok(test_long_list(@opts), 'read_interval range');
is($ob->read_interval(0xffffffff), 0xffffffff, 'set read_interval');

@opts = $ob->read_const_time;
ok(test_long_list(@opts), 'read_const_time range');
is($ob->read_const_time(0), 0, 'set read_const_time');

@opts = $ob->read_char_time;
ok(test_long_list(@opts), 'read_char_time range');
is($ob->read_char_time(0), 0, 'set read_char_time');

## 109 - 112: Write Timeouts

@opts = $ob->write_const_time;
ok(test_long_list(@opts), 'write_const_time range');
is($ob->write_const_time(200), 200, 'set write_const_time');

@opts = $ob->write_char_time;
ok(test_long_list(@opts), 'write_char_time range');
is($ob->write_char_time(10), 10, 'set write_char_time');

## 113 - 116: Other Parameters (Defaults)

is($ob->binary(1), 1, 'binary');

is($ob->parity_enable(0), 0, 'parity_enable');

@opts = $ob->xon_limit;
ok(test_short_list(@opts), 'xon_limit range');

@opts = $ob->xoff_limit;
ok(test_short_list(@opts), 'xoff_limit range');

## 117 - 119: Finish Initialize

is($ob->write_settings, 1, 'write_settings');

is($ob->xon_limit(100), 100, 'xon_limit');
is($ob->xoff_limit(200), 200, 'xoff_limit');

## 120 - 137: Constants from Package

is($ob->BM_fCtsHold, 1, 'constant BM_fCtsHold');
is($ob->BM_fDsrHold, 2, 'constant BM_fDsrHold');
is($ob->BM_fRlsdHold, 4, 'constant BM_fRlsdHold');
is($ob->BM_fXoffHold, 8, 'constant BM_fXoffHold');
is($ob->BM_fXoffSent, 0x10, 'constant BM_fXoffSent');
is($ob->BM_fEof, 0x20, 'constant BM_fEof');
is($ob->BM_fTxim, 0x40, 'constant BM_fTxim');

is($ob->MS_CTS_ON, 0x10, 'constant MS_CTS_ON');
is($ob->MS_DSR_ON, 0x20, 'constant MS_DSR_ON');
is($ob->MS_RING_ON, 0x40, 'constant MS_RING_ON');
is($ob->MS_RLSD_ON, 0x80, 'constant MS_RLSD_ON');

is($ob->CE_RXOVER, 0x1, 'constant CE_RXOVER');
is($ob->CE_OVERRUN, 0x2, 'constant CE_OVERRUN');
is($ob->CE_RXPARITY, 0x4, 'constant CE_RXPARITY');
is($ob->CE_FRAME, 0x8, 'constant CE_FRAME');
is($ob->CE_BREAK, 0x10, 'constant CE_BREAK');
is($ob->CE_TXFULL, 0x100, 'constant CE_TXFULL');
is($ob->CE_MODE, 0x8000, 'constant CE_MODE');

## 138 - 144: Status

is($ob->purge_all, 1, 'purge_all');
@opts = $ob->status;
is(scalar @opts, 4, 'status');

# for an unconnected port, should be $in=0, $out=0, $blk=1 (no CTS), $err=0
# USB and virtual ports can be different, but stil 4 elements

($blk, $in, $out, $err)=@opts;
# warn "WCB status: $blk, $in, $out, $err\n";

ok(defined $blk, 'blocking byte');
ok(defined $in, 'input count');
ok(defined $out, 'output count');
ok(defined $err, 'error byte');

## xxx - xxx: Optional Messages

@opts = $ob->user_msg;
ok(test_bin_list(@opts), 'user_msg_array');
is(scalar $ob->user_msg, 0, 'user_msg init OFF');
is(scalar $ob->user_msg(1), 1, 'user_msg ON');

@opts = $ob->error_msg;
ok(test_bin_list(@opts), 'error_msg_array');
is(scalar $ob->error_msg, 0, 'error_msg init OFF');
is($ob->error_msg(1), 1, 'error_msg ON');

is($ob->handshake("none"), 'none', 'set handshake none');

## 145 - 150: Save Configuration
## (before any writes which might confuse USB driver)

ok(scalar $ob->save($cfgfile), 'save');

is($ob->baudrate, 9600, 'baudrate');
is($ob->parity, 'none', 'parity');
is($ob->handshake, 'none', 'set handshake none');
is($ob->databits, 8, 'databits');
is($ob->stopbits, 1, 'stopbits');

## 151 - 180: No Handshake, Polled Write, $BUFFEROUT detection

$tick=$ob->get_tick_count;
is($ob->write($line), 180, 'write 180 characters');
$tock=$ob->get_tick_count;

$err=$tock - $tick;
if ($err < 120) {
	$BUFFEROUT = 1;	# USB and virtual ports can't test output timing
}
if ($BUFFEROUT) {
	is_bad ($err > 300, 'skip write timing');
} else {
	is_bad (($err < 120) or ($err > 300), 'write timing');
}
print "<185> elapsed time=$err\n";

ok(defined $ob->reset_error, 'reset_error');
	
SKIP: {
    skip "Can't rely on status and no input", 26 if $BUFFEROUT;
    ($blk, $in, $out, $err)=$ob->status;
    is($blk, 0, 'blocking bits');
    is($in, 0, 'input bytes');
    is($out, 0, 'output bytes');
    is($err, 0, 'error bytes');

    ## 131 - 136: Block by DSR without Output

    is($ob->handshake("dtr"), 'dtr', 'set handshake dtr');

    ($blk, $in, $out, $err)=$ob->status;
    ok(defined $blk, 'DSR blocking bits');
    is($in, 0, 'input bytes');
    is($out, 0, 'output bytes');
    is($err, 0, 'error bytes');

    ## 137 - 141: Unsent XOFF without Output

    is($ob->handshake("xoff"), 'xoff', 'set handshake xoff');

    ($blk, $in, $out, $err)=$ob->status;
    is($blk, 0, 'blocking bits');
    is($in, 0, 'input bytes');
    is($out, 0, 'output bytes');
    is($err, 0, 'error bytes');

    ## 142 - 150: Block by XOFF without Output

    ok($ob->xoff_active, 'xoff active');
    ok(scalar $ob->transmit_char(0x33), 'transmit xoff');

    $in2=($ob->BM_fXoffHold | $ob->BM_fTxim);
    ($blk, $in, $out, $err)=$ob->status;
    ok($blk & $in2, 'XoffHold or Txim');
    is($in, 0, 'input bytes');
    is($out, 0, 'output bytes');
    is($err, 0, 'error bytes');

    ok($ob->xon_active, 'xon_active');
    ($blk, $in, $out, $err)=$ob->status;
    is($blk, 0, 'blocking bits');
    is($in, 0, 'input bytes');
    is($err, 0, 'error bytes');

    ## 151 - 152: No Handshake

    is($ob->handshake("none"), 'none', 'set handshake none');
    ok(scalar $ob->purge_all, 'purge_all');
}

ok(defined $ob->reset_error, 'reset_error');

## 187 - xxx: Check Saved Configuration

ok($ob->close, 'close');
undef $ob;

## 188 - 190: Check File Headers

ok(open(CF, "$cfgfile"), 'open config file');
my ($signature, $name, @values) = <CF>;
close CF;

ok(1 == grep(/SerialPort_Configuration_File/, $signature), 'signature');

chomp $name;
if ($file =~ /^COM\d+$/io) {
	is($name, '\\\\.\\'.$file, 'config file device');
} else {
	is($name, $file, 'config file device');
}

## 191 - 192: Check that Values listed exactly once

$fault = 0;
foreach $e (@values) {
    chomp $e;
    ($in, $out) = split(',',$e);
    $fault++ if ($out eq "");
    $required_param{$in}++;
    }
is($fault, 0, 'no duplicate values exist');

$fault = 0;
foreach $e (@necessary_param) {
    $fault++ unless ($required_param{$e} ==1);
    }
is($fault, 0, 'all required keys appear once');

## 193 - 125: Reopen as Tie

    # constructor = TIEHANDLE method

ok ($ob = tie(*PORT,'Win32::SerialPort', $cfgfile), 'tie');
die unless ($ob);    # next tests would die at runtime

SKIP: {
    skip "Tied filehandle timing and CRLF conversions", 35 if $BUFFEROUT;

    # tie to PRINT method
    $tick=$ob->get_tick_count;
    $pass=print PORT $line;
    is($pass, 1, 'PRINT method');
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;
    is_bad (($err < 160) or ($err > 245), 'write timing');
    print "<195> elapsed time=$err\n";

    # tie to PRINTF method
    $tick=$ob->get_tick_count;
    $pass=printf PORT "123456789_%s_987654321", $line;
    $tock=$ob->get_tick_count;
    is($pass, 1, 'PRINTF method');
    $err=$tock - $tick;
    is_bad (($err < 180) or ($err > 265), 'write timing');
    print "<215> elapsed time=$err\n";

    is($ob->read_const_time(300), 300, 'read_const_time');
    is($ob->read_char_time(20), 20, 'read_char_time');
    $tick=$ob->get_tick_count;
    ($in, $in2) = $ob->read(10);
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;

    is($in, 0, 'read disconnected port');
    unless ($in == 0) {
	    die "\nLooks like you have a modem on the serial port!\n".
       		"Please turn it off, or remove it and restart the tests.\n";
    }
    ok ($in2 eq "", 'no data');
    $err=$tock - $tick;
    is_bad (($err < 475) or ($err > 585), 'read timeout');
    print "<500> elapsed time=$err\n";
    is ($ob->read_char_time(0), 0, 'reset read_char_time');
    $tick=$ob->get_tick_count;
    $in2= getc PORT;
    $tock=$ob->get_tick_count;

    is_bad (defined $in2, 'getc');
    $err=$tock - $tick;
    is_bad (($err < 275) or ($err > 365), 'getc timeout');
    print "<300> elapsed time=$err\n";

    is ($ob->read_const_time(0), 0, 'reset read_const_time');
    $tick=$ob->get_tick_count;
    $in2= getc PORT;
    $tock=$ob->get_tick_count;

    is_bad (defined $in2);
    $err=$tock - $tick;
    is_bad ($err > 50);
    print "<0> elapsed time=$err\n";

    # output conversion defaults: -opost onlcr -ocrnl
    $e = "\r"x100;
    $e .= "\n"x160;
    $tick=$ob->get_tick_count;
    $pass=print PORT $e;
    $tock=$ob->get_tick_count;
    
    is($pass, 1, 'default no conversion');
    $err=$tock - $tick;
    is_bad (($err < 250) or ($err > 300), 'default timing');
    ## 260 characters, no mods
    print "<275> elapsed time=$err\n";
    
    is($ob->stty_opost(1), 1, 'opost');
    $tick=$ob->get_tick_count;
    $pass=print PORT $e;
    $tock=$ob->get_tick_count;
    
    is($pass, 1, 'opost conversion');
    $err=$tock - $tick;
    ## 100 "\r" + 160 "\r"=>"\r\n" = 420 characters
    is_bad (($err < 410) or ($err > 465), 'opost timing');
    print "<435> elapsed time=$err\n";
    
    is($ob->stty_ocrnl(1), 1, 'ocrnl');
    $tick=$ob->get_tick_count;
    $pass=print PORT $e;
    $tock=$ob->get_tick_count;
    
    is($pass, 1, 'ocrnl conversion');
    $err=$tock - $tick;
    ## 100 "\r"=>"\n" which gives 260 "\n"=>"\r\n" = 520 characters
    is_bad (($err < 510) or ($err > 575), 'ocrnl timing');
    print "<535> elapsed time=$err\n";
    
    is($ob->stty_opost(0), 0, 'opost off');
    $tick=$ob->get_tick_count;
    $pass=print PORT $e;
    $tock=$ob->get_tick_count;
    
    is($pass, 1, 'opost conversion off');
    $err=$tock - $tick;
    ## back to 260 characters with processing disabled
    is_bad (($err < 250) or ($err > 300), 'opost off timing');
    print "<275> elapsed time=$err\n";
    
    is($ob->stty_opost(1), 1, 'opost on');
    $tick=$ob->get_tick_count;
    $pass=print PORT $e;
    $tock=$ob->get_tick_count;
    
    is($pass, 1, 'opost conversion on');
    $err=$tock - $tick;
    ## returning to 520 characters when enabled again
    is_bad (($err < 510) or ($err > 575), 'opost timing');
    print "<535> elapsed time=$err\n";
    
    is($ob->stty_ocrnl(0), 0, 'ocrnl off');
    $tick=$ob->get_tick_count;
    $pass=print PORT $e;
    $tock=$ob->get_tick_count;
    
    is($pass, 1, 'ocrnl conversion off');
    $err=$tock - $tick;
    ## stop just the "\r=>"\n" so 420 characters
    is_bad (($err < 410) or ($err > 465), 'ocrnl off timing');
    print "<435> elapsed time=$err\n";
    
        # tie to READLINE method
    is ($ob->read_const_time(500), 500, 'read_const_time');
    $tick=$ob->get_tick_count;
    $fail = <PORT>;
    $tock=$ob->get_tick_count;
    
    is_bad(defined $fail, 'READLINE');
    $err=$tock - $tick;
    is_bad (($err < 480) or ($err > 540), 'READLINE timeout');
    print "<500> elapsed time=$err\n";
}

## 195 - 204: Port in Use (new + quiet)

my $ob2;
is_bad ($ob2 = Win32::SerialPort->new ($file), 'in use new');
is_bad (defined $ob2, 'returns undef');
is ($ob2 = Win32::SerialPort->new ($file, 1), 0, 'zero if quiet');
is_bad ($ob2 = Win32::SerialPort->new ($file, 0), 'quiet off');
is_bad (defined $ob2, 'back to undef');

is_bad ($ob2 = Win32API::CommPort->new ($file), 'CommPort new');
is_bad (defined $ob2, 'undef in use');
is ($ob2 = Win32API::CommPort->new ($file, 1), 0, 'except zero if quiet');
is_bad ($ob2 = Win32API::CommPort->new ($file, 0), 'not quiet');
is_bad (defined $ob2, 'CommPort undef');

## 225 - 278: Other DCB bits

      # for handshake == "none"
is($ob->output_dsr, 0, 'output_dsr');
is($ob->output_cts, 0, 'output_cts');
is($ob->input_xoff, 0, 'input_xoff');
is($ob->output_xoff, 0, 'output_xoff');

is($ob->ignore_null(0), 0, 'ignore_null');
is($ob->ignore_no_dsr(0), 0, 'ignore_no_dsr');

is($ob->subst_pe_char(0), 0, 'subst_pe_error');
is($ob->abort_on_error(0), 0, 'abort_on_error');
is($ob->tx_on_xoff(0), 0, 'tx_on_xoff');

is($ob->ignore_null, 0, 'ignore_null');
ok($ob->ignore_null(1), 'ignore_null_on');
ok($ob->ignore_null, 'ignore_null');
is($ob->ignore_null(0), 0, 'ignore_null_off');
is($ob->ignore_null, 0, 'ignore_null');

is($ob->ignore_no_dsr, 0, 'ignore_no_dsr');
ok($ob->ignore_no_dsr(1), 'ignore_no_dsr on');
ok($ob->ignore_no_dsr, 'ignore_no_dsr');
is($ob->ignore_no_dsr(0), 0, 'ignore_no_dsr off');
is($ob->ignore_no_dsr, 0, 'ignore_no_dsr');

is($ob->subst_pe_char, 0, 'subst_pe_char');
ok($ob->subst_pe_char(1), 'subst_pe_char on');
ok($ob->subst_pe_char, 'subst_pe_char');
is($ob->subst_pe_char(0), 0, 'subst_pe_char off');
is($ob->subst_pe_char, 0, 'subst_pe_char');

is($ob->abort_on_error, 0, 'abort_on_error');
ok($ob->abort_on_error(1), 'abort_on_error on');
ok($ob->abort_on_error, 'abort_on_error');
is($ob->abort_on_error(0), 0, 'abort_on_error off');
is($ob->abort_on_error, 0, 'abort_on_error');

is($ob->tx_on_xoff, 0, 'tx_on_xoff');
ok($ob->tx_on_xoff(1), 'tx_on_xoff on');
ok($ob->tx_on_xoff, 'tx_on_xoff');
is($ob->tx_on_xoff(0), 0, 'tx_on_xoff off');
is($ob->tx_on_xoff, 0, 'tx_on_xoff');

is($ob->handshake("dtr"), 'dtr', 'handshake dtr');
ok($ob->output_dsr, 'output_dsr');
is($ob->output_cts, 0, 'output_cts');
is($ob->input_xoff, 0, 'input_xoff');
is($ob->output_xoff, 0, 'output_xoff');

is($ob->handshake("rts"), 'rts', 'handshake rts');
is($ob->output_dsr, 0, 'output_dsr');
ok($ob->output_cts, 'output_cts');
is($ob->input_xoff, 0, 'input_xoff');
is($ob->output_xoff, 0, 'output_xoff');

is($ob->handshake("xoff"), 'xoff', 'handshake xoff');
is($ob->output_dsr, 0, 'output_dsr');
is($ob->output_cts, 0, 'output_cts');
ok($ob->input_xoff, 'input_xoff');
ok($ob->output_xoff, 'output_xoff');

is($ob->handshake("none"), 'none', 'handshake none');
is($ob->output_dsr, 0, 'output_dsr');
is($ob->output_cts, 0, 'output_cts');
is($ob->input_xoff, 0, 'input_xoff');
is($ob->output_xoff, 0, 'output_xoff');

## 259 - 2xx: Pulsed DCB bits

    ok ($ob->dtr_active(0), 'dtr inactive');
    $tick=$ob->get_tick_count;
    ok ($ob->pulse_dtr_on(100), 'pulse_dtr_on');
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;
    is_bad (($err < 180) or ($err > 250), 'pulse dtr timing');
    print "<200> elapsed time=$err\n";

    ok ($ob->dtr_active(1), 'dtr active');
    $tick=$ob->get_tick_count;
    ok ($ob->pulse_dtr_off(200), 'pulse_dtr_off');
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;
    is_bad (($err < 370) or ($err > 450), 'dtr off timing');
    print "<400> elapsed time=$err\n";

    ok ($ob->rts_active(0), 'rts inactive');
    $tick=$ob->get_tick_count;
    ok ($ob->pulse_rts_on(150), 'pulse_rts_on');
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;
    is_bad (($err < 275) or ($err > 350), 'rts on timing');
    print "<300> elapsed time=$err\n";

    ok ($ob->rts_active(1), 'rts active');
    $tick=$ob->get_tick_count;
    ok ($ob->pulse_rts_off(50), 'pulse_rts_off');
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;
    is_bad (($err < 80) or ($err > 150), 'rts off timing');
    print "<100> elapsed time=$err\n";

    $tick=$ob->get_tick_count;
    ok ($ob->pulse_break_on(50), 'pulse break on');
    $tock=$ob->get_tick_count;
    $err=$tock - $tick;
    is_bad (($err < 80) or ($err > 150), 'break timing');
    print "<100> elapsed time=$err\n";

    ok ($ob->rts_active(0), 'rts inactive');
    ok ($ob->dtr_active(0), 'dtr inactive');


    # destructor = CLOSE method
    ok(close PORT, 'close');				# 275

    # destructor = DESTROY method
undef $ob;					# Don't forget this one!!
untie *PORT;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)