1#!/usr/bin/perl -w 2 3use lib '.','./t','./blib/lib','../blib/lib'; 4# can run from here or distribution base 5 6# Before installation is performed this script should be runnable with 7# `perl test1.t time' which pauses `time' seconds (1..5) between pages 8 9######################### We start with some black magic to print on failure. 10 11use Test::More; 12eval "use DefaultPort;"; 13if ($@) { 14 plan skip_all => 'No serial port selected for use with testing'; 15} 16else { 17 plan tests => 171; 18} 19 20use POSIX qw(uname); 21# can't drain ports without modems on them under POSIX in Solaris 2.6 22my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname(); 23my $SKIPDRAIN=0; 24if ($sysname eq "SunOS" && $machine =~ /^sun/) { 25 $SKIPDRAIN=1; 26} 27 28use AltPort qw( :PARAM 0.10 ); # check inheritance & export 29 30######################### End of black magic. 31 32# Insert your test code below (better if it prints "ok 13" 33# (correspondingly "not ok 13") depending on the success of chunk 13 34# of the test code): 35 36use strict; 37 38## verifies the (0, 1) list returned by binary functions 39sub test_bin_list { 40 return undef unless (@_ == 2); 41 return undef unless (0 == shift); 42 return undef unless (1 == shift); 43 return 1; 44} 45 46sub is_ok { 47 local $Test::Builder::Level = $Test::Builder::Level + 1; 48 return ok(shift); 49} 50 51sub is_zero { 52 local $Test::Builder::Level = $Test::Builder::Level + 1; 53 return ok(shift == 0); 54} 55 56sub is_bad { 57 local $Test::Builder::Level = $Test::Builder::Level + 1; 58 return ok(!shift); 59} 60 61# assume a "vanilla" port on "/dev/ttyS0" 62 63my $file = "/dev/ttyS0"; 64if ($SerialJunk::Makefile_Test_Port) { 65 $file = $SerialJunk::Makefile_Test_Port; 66} 67if (exists $ENV{Makefile_Test_Port}) { 68 $file = $ENV{Makefile_Test_Port}; 69} 70 71my $naptime = 0; # pause between output pages 72if (@ARGV) { 73 $naptime = shift @ARGV; 74 unless ($naptime =~ /^[0-5]$/) { 75 die "Usage: perl test?.t [ page_delay (0..5) ] [ /dev/ttySx ]"; 76 } 77} 78if (@ARGV) { 79 $file = shift @ARGV; 80} 81 82my $cfgfile = "$file"."_test.cfg"; 83$cfgfile =~ s/.*\///; 84 85my $fault = 0; 86my $ob; 87my $pass; 88my $fail; 89my $in; 90my $in2; 91my @opts; 92my $out; 93my $err; 94my $blk; 95my $e; 96my $tick; 97my $tock; 98my %required_param; 99 100my $s="testing is a wonderful thing - this is a 60 byte long string"; 101# 123456789012345678901234567890123456789012345678901234567890 102my $line = $s.$s.$s; # about 185 MS at 9600 baud 103 104is_ok(0x0 == nocarp); # 2 105my @necessary_param = AltPort->set_test_mode_active(1); 106 107unlink $cfgfile; 108foreach $e (@necessary_param) { $required_param{$e} = 0; } 109 110## 2 - 5 SerialPort Global variable ($Babble); 111 112ok(scalar(AltPort->debug) == 0); # 3: start out false 113ok(scalar(AltPort->debug(1))); # 4: set it 114 115# 5: yes_true subroutine, no need to SHOUT if it works 116 117ok ( AltPort->debug("T")); 118ok (!AltPort->debug("F")); 119 120{ 121 no strict 'subs'; 122 ok ( AltPort->debug(T)); 123 ok (!AltPort->debug(F)); 124 ok ( AltPort->debug(Y)); 125 ok (!AltPort->debug(N)); 126 ok ( AltPort->debug(ON)); 127 ok (!AltPort->debug(OFF)); 128 ok ( AltPort->debug(TRUE)); 129 ok (!AltPort->debug(FALSE)); 130 ok ( AltPort->debug(Yes)); 131 ok (!AltPort->debug(No)); 132 ok ( AltPort->debug("yes")); 133 ok (!AltPort->debug("f")); 134} 135 136@opts = AltPort->debug; # 6: binary_opt array 137is_ok(test_bin_list(@opts)); 138 139# 7: Constructor 140 141unless (is_ok ($ob = AltPort->new ($file))) { 142 printf "could not open port $file\n"; 143 exit 1; 144 # next test would die at runtime without $ob 145} 146 147#### 8 - 64: Check Port Capabilities 148 149## 8 - 21: Binary Capabilities 150 151is_ok($ob->can_baud); # 8 152is_ok($ob->can_databits); # 9 153is_ok($ob->can_stopbits); # 10 154is_ok($ob->can_dtrdsr); # 11 155is_ok($ob->can_handshake); # 12 156is_ok($ob->can_parity_check); # 13 157is_ok($ob->can_parity_config); # 14 158is_ok($ob->can_parity_enable); # 15 159is_zero($ob->can_rlsd); # 16 160is_ok($ob->can_rtscts); # 17 161is_ok($ob->can_xonxoff); # 18 162is_zero($ob->can_interval_timeout); # 19 163is_ok($ob->can_total_timeout); # 20 164is_ok($ob->can_xon_char); # 21 165if ($naptime) { 166 print "++++ page break\n"; 167 sleep $naptime; 168} 169 170is_zero($ob->can_spec_char); # 22 171is_zero($ob->can_16bitmode); # 23 172is_ok($ob->is_rs232); # 24 173is_zero($ob->is_modem); # 25 174 175#### 26 - xx: Set Basic Port Parameters 176 177## 26 - 31: Baud (Valid/Invalid/Current) 178 179@opts=$ob->baudrate; # list of allowed values 180is_ok(1 == grep(/^9600$/, @opts)); # 26 181is_zero(scalar grep(/^9601/, @opts)); # 27 182 183is_ok($in = $ob->baudrate); # 28 184is_ok(1 == grep(/^$in$/, @opts)); # 29 185 186is_bad(scalar $ob->baudrate(9601)); # 30 187is_ok($in == $ob->baudrate(9600)); # 31 188 # leaves 9600 pending 189 190## 32 - xx: Parity (Valid/Invalid/Current) 191 192@opts=$ob->parity; # list of allowed values 193is_ok(1 == grep(/none/, @opts)); # 32 194is_zero(scalar grep(/any/, @opts)); # 33 195 196is_ok($in = $ob->parity); # 34 197is_ok(1 == grep(/^$in$/, @opts)); # 35 198 199is_bad(scalar $ob->parity("any")); # 36 200is_ok($in eq $ob->parity("none")); # 37 201 # leaves "none" pending 202 203## 38 - 43: Databits (Valid/Invalid/Current) 204 205@opts=$ob->databits; # list of allowed values 206is_ok(1 == grep(/8/, @opts)); # 38 207is_zero(scalar grep(/4/, @opts)); # 39 208 209is_ok($in = $ob->databits); # 40 210is_ok(1 == grep(/^$in$/, @opts)); # 41 211 212is_bad(scalar $ob->databits(3)); # 42 213is_ok($in == $ob->databits(8)); # 43 214 # leaves 8 pending 215 216if ($naptime) { 217 print "++++ page break\n"; 218 sleep $naptime; 219} 220 221## 44 - 49: Stopbits (Valid/Invalid/Current) 222 223@opts=$ob->stopbits; # list of allowed values 224is_ok(1 == grep(/2/, @opts)); # 44 225is_zero(scalar grep(/1.5/, @opts)); # 45 226 227is_ok($in = $ob->stopbits); # 46 228is_ok(1 == grep(/^$in$/, @opts)); # 47 229 230is_bad(scalar $ob->stopbits(3)); # 48 231is_ok($in == $ob->stopbits(1)); # 49 232 # leaves 1 pending 233 234## 50 - 55: Handshake (Valid/Invalid/Current) 235 236@opts=$ob->handshake; # list of allowed values 237is_ok(1 == grep(/none/, @opts)); # 50 238is_zero(scalar grep(/moo/, @opts)); # 51 239 240is_ok($in = $ob->handshake); # 52 241is_ok(1 == grep(/^$in$/, @opts)); # 53 242 243is_bad(scalar $ob->handshake("moo")); # 54 244is_ok($in = $ob->handshake("rts")); # 55 245 # leaves "rts" pending for status 246 247## 56 - 61: Buffer Size 248 249($in, $out) = $ob->buffer_max(512); 250is_bad(defined $in); # 56 251($in, $out) = $ob->buffer_max; 252is_ok(defined $in); # 57 253 254if (($in > 0) and ($in < 4096)) { $in2 = $in; } 255else { $in2 = 4096; } 256 257if (($out > 0) and ($out < 4096)) { $err = $out; } 258else { $err = 4096; } 259 260is_ok(scalar $ob->buffers($in2, $err)); # 58 261 262@opts = $ob->buffers(4096, 4096, 4096); 263is_bad(defined $opts[0]); # 59 264($in, $out)= $ob->buffers; 265is_ok($in2 == $in); # 60 266is_ok($out == $err); # 61 267 268## 62 - 64: Other Parameters (Defaults) 269 270is_ok("AltPort" eq $ob->alias("AltPort")); # 62 271is_zero(scalar $ob->parity_enable(0)); # 63 272is_ok($ob->write_settings); # 64 273is_ok($ob->binary); # 65 274 275if ($naptime) { 276 print "++++ page break\n"; 277 sleep $naptime; 278} 279 280## 66 - 67: Read Timeout Initialization 281 282is_zero($ob->read_const_time); # 66 283is_zero($ob->read_char_time); # 67 284 285## 68 - 74: No Handshake, Polled Write 286 287is_ok("none" eq $ob->handshake("none")); # 68 288 289$tick=$ob->get_tick_count; 290$pass=$ob->write($line); 291if ($SKIPDRAIN) { 292 is_zero(0); # 69 293 select(undef,undef,undef,0.185); 294} else { 295 is_ok(1 == $ob->write_drain); # 69 296} 297$tock=$ob->get_tick_count; 298 299is_ok($pass == 180); # 70 300$err=$tock - $tick; 301is_bad (($err < 160) or ($err > 220)); # 71 302print "<185> elapsed time=$err\n"; 303 304is_ok(scalar $ob->purge_tx); # 72 305is_ok(scalar $ob->purge_rx); # 73 306is_ok(scalar $ob->purge_all); # 74 307 308## 75 - 80: Optional Messages 309 310@opts = $ob->user_msg; 311is_ok(test_bin_list(@opts)); # 75 312is_zero(scalar $ob->user_msg); # 76 313is_ok(1 == $ob->user_msg(1)); # 77 314 315@opts = $ob->error_msg; 316is_ok(test_bin_list(@opts)); # 78 317is_zero(scalar $ob->error_msg); # 79 318is_ok(1 == $ob->error_msg(1)); # 80 319 320## 81: Save Configuration 321 322is_ok(scalar $ob->save($cfgfile)); # 81 323undef $ob; 324 325sleep 1; 326 327## 82 - 116: Reopen as (mostly 5.003 Compatible) Tie 328 329 # constructor = TIEHANDLE method # 82 330unless (is_ok ($ob = tie(*PORT,'AltPort', $cfgfile))) { 331 printf "could not reopen port from $cfgfile\n"; 332 exit 1; 333 # next test would die at runtime without $ob 334} 335 336 # tie to PRINT method 337$tick=$ob->get_tick_count; 338$pass=print PORT $line; 339if ($SKIPDRAIN) { 340 is_zero(0); # 83 341 select(undef,undef,undef,0.185); 342} else { 343 is_ok(1 == $ob->write_drain); # 83 344} 345$tock=$ob->get_tick_count; 346 347is_ok($pass == 1); # 84 348 349$err=$tock - $tick; 350is_bad (($err < 160) or ($err > 235)); # 85 351print "<185> elapsed time=$err\n"; 352 353if ($naptime) { 354 print "++++ page break\n"; 355 sleep $naptime; 356} 357 358 # tie to PRINTF method 359$tick=$ob->get_tick_count; 360if ( $] < 5.004 ) { 361 $out=sprintf "123456789_%s_987654321", $line; 362 $pass=print PORT $out; 363} 364else { 365 $pass=printf PORT "123456789_%s_987654321", $line; 366} 367if ($SKIPDRAIN) { 368 is_zero(0); # 86 369 select(undef,undef,undef,0.205); 370} else { 371 is_ok(1 == $ob->write_drain); # 86 372} 373$tock=$ob->get_tick_count; 374 375is_ok($pass == 1); # 87 376$err=$tock - $tick; 377is_bad (($err < 170) or ($err > 255)); # 88 378print "<205> elapsed time=$err\n"; 379 380is_ok (300 == $ob->read_const_time(300)); # 89 381is_ok (20 == $ob->read_char_time(20)); # 90 382$tick=$ob->get_tick_count; 383$in2 = $ob->input; 384$tock=$ob->get_tick_count; 385 386is_ok (20 == $ob->read_char_time); # 91 387unless (is_ok ($in2 eq "")) { # 92 388 die "\n92: Looks like you have a modem on the serial port!\n". 389 "Please turn it off, or remove it and restart the tests.\n"; 390 # many tests following here will fail if there is modem attached 391} 392 393$err=$tock - $tick; 394is_bad ($err > 50); # 93 395print "<0> elapsed time=$err\n"; 396 397is_ok (0 == $ob->read_char_time(0)); # 94 398$tick=$ob->get_tick_count; 399$in2= getc PORT; 400$tock=$ob->get_tick_count; 401 402is_bad (defined $in2); # 95 403$err=$tock - $tick; 404is_bad (($err < 275) or ($err > 365)); # 96 405print "<300> elapsed time=$err\n"; 406 407is_ok (0 == $ob->read_const_time(0)); # 97 408$tick=$ob->get_tick_count; 409$in2= getc PORT; 410$tock=$ob->get_tick_count; 411 412is_bad (defined $in2); # 98 413$err=$tock - $tick; 414is_bad ($err > 50); # 99 415print "<0> elapsed time=$err\n"; 416 417## 99 - 103: Bad Port (new + quiet) 418 419$file = "/dev/badport"; 420my $ob2; 421is_bad ($ob2 = AltPort->new ($file)); # 100 422is_bad (defined $ob2); # 101 423is_bad ($ob2 = AltPort->new ($file, 1)); # 102 424is_bad ($ob2 = AltPort->new ($file, 0)); # 103 425 426if ($naptime) { 427 print "++++ page break\n"; 428 sleep $naptime; 429} 430 431is_bad (defined $ob2); # 104 432 433## 104 - 119: Output bits and pulses 434 435SKIP: { 436 skip "Can't IOCTL", 14 unless $ob->can_ioctl; 437 438 is_ok ($ob->dtr_active(0)); # 105 439 $tick=$ob->get_tick_count; 440 is_ok ($ob->pulse_dtr_on(100)); # 106 441 $tock=$ob->get_tick_count; 442 $err=$tock - $tick; 443 if (!is_bad (($err < 180) or ($err > 265))) {# 107 444 if ($err > 265) { 445 warn "\n107: DTR toggle took too long. Is this a Solaris serial port?\n\tPlease read the 'SOLARIS TROUBLE' section in the README\n\tto correct this problem.\n"; 446 } 447 } 448 print "<200> elapsed time=$err\n"; 449 450 is_ok ($ob->dtr_active(1)); # 108 451 $tick=$ob->get_tick_count; 452 is_ok ($ob->pulse_dtr_off(200)); # 109 453 $tock=$ob->get_tick_count; 454 $err=$tock - $tick; 455 if (!is_bad (($err < 370) or ($err > 485))) {# 110 456 if ($err > 485) { 457 warn "\n110: DTR toggle took too long. Is this a Solaris serial port?\n\tPlease read the 'SOLARIS TROUBLE' section in the README\n\tto correct this problem.\n"; 458 } 459 } 460 print "<400> elapsed time=$err\n"; 461 462 SKIP: { 463 skip "Can't RTS", 7 unless $ob->can_rts(); 464 465 is_ok ($ob->rts_active(0)); # 111 466 $tick=$ob->get_tick_count; 467 is_ok ($ob->pulse_rts_on(150)); # 112 468 $tock=$ob->get_tick_count; 469 $err=$tock - $tick; 470 is_bad (($err < 275) or ($err > 365)); # 113 471 print "<300> elapsed time=$err\n"; 472 473 is_ok ($ob->rts_active(1)); # 114 474 $tick=$ob->get_tick_count; 475 is_ok ($ob->pulse_rts_on(50)); # 115 476 $tock=$ob->get_tick_count; 477 $err=$tock - $tick; 478 is_bad (($err < 80) or ($err > 145)); # 116 479 print "<100> elapsed time=$err\n"; 480 481 is_ok ($ob->rts_active(0)); # 117 482 } 483 is_ok ($ob->dtr_active(0)); # 118 484} 485 486$tick=$ob->get_tick_count; 487is_ok ($ob->pulse_break_on(250)); # 119 488$tock=$ob->get_tick_count; 489$err=$tock - $tick; 490is_bad (($err < 235) or ($err > 900)); # 120 491print "<500> elapsed time=$err\n"; 492 493if ($naptime) { 494 print "++++ page break\n"; 495 sleep $naptime; 496} 497 498## 121 - 135: Record and Field Separators 499 500my $r = "I am the very model of an output record separator"; ## =49 501# 1234567890123456789012345678901234567890123456789 502my $f = "The fields are alive with the sound of music"; ## =44 503my $ff = "$f, with fields they have sung for a thousand years"; ## =93 504my $rr = "$r, not animal or vegetable or mineral or any other"; ## =98 505 506is_ok($ob->output_record_separator eq ""); # 121 507is_ok($ob->output_field_separator eq ""); # 122 508$, = ""; 509$\ = ""; 510 511 # tie to PRINT method 512$tick=$ob->get_tick_count; 513$pass=print PORT $s, $s, $s; 514if ($SKIPDRAIN) { 515 is_zero(0); # 123 516 select(undef,undef,undef,0.185); 517} else { 518 is_ok(1 == $ob->write_drain); # 123 519} 520$tock=$ob->get_tick_count; 521 522is_ok($pass == 1); # 124 523 524$err=$tock - $tick; 525is_bad (($err < 160) or ($err > 210)); # 125 526print "<185> elapsed time=$err\n"; 527 528is_ok($ob->output_field_separator($f) eq ""); # 126 529$tick=$ob->get_tick_count; 530$pass=print PORT $s, $s, $s; 531if ($SKIPDRAIN) { 532 is_zero(0); # 127 533 select(undef,undef,undef,0.275); 534} else { 535 is_ok(1 == $ob->write_drain); # 127 536} 537$tock=$ob->get_tick_count; 538 539is_ok($pass == 1); # 128 540 541$err=$tock - $tick; 542is_bad (($err < 260) or ($err > 310)); # 129 543print "<275> elapsed time=$err\n"; 544 545is_ok($ob->output_record_separator($r) eq ""); # 130 546$tick=$ob->get_tick_count; 547$pass=print PORT $s, $s, $s; 548if ($SKIPDRAIN) { 549 is_zero(0); # 131 550 select(undef,undef,undef,0.325); 551} else { 552 is_ok(1 == $ob->write_drain); # 131 553} 554$tock=$ob->get_tick_count; 555 556is_ok($pass == 1); # 132 557 558$err=$tock - $tick; 559is_bad (($err < 310) or ($err > 360)); # 133 560print "<325> elapsed time=$err\n"; 561 562is_ok($ob->output_record_separator eq $r); # 134 563is_ok($ob->output_field_separator eq $f); # 135 564$, = $ff; 565$\ = $rr; 566 567$tick=$ob->get_tick_count; 568$pass=print PORT $s, $s, $s; 569if ($SKIPDRAIN) { 570 is_zero(0); # 136 571 select(undef,undef,undef,0.325); 572} else { 573 is_ok(1 == $ob->write_drain); # 136 574} 575$tock=$ob->get_tick_count; 576 577$, = ""; 578$\ = ""; 579is_ok($pass == 1); # 137 580 581$err=$tock - $tick; 582is_bad (($err < 310) or ($err > 360)); # 138 583print "<325> elapsed time=$err\n"; 584 585if ($naptime) { 586 print "++++ page break\n"; 587 sleep $naptime; 588} 589 590$, = $ff; 591$\ = $rr; 592is_ok($ob->output_field_separator("") eq $f); # 139 593$tick=$ob->get_tick_count; 594$pass=print PORT $s, $s, $s; 595if ($SKIPDRAIN) { 596 is_zero(0); # 140 597 select(undef,undef,undef,0.425); 598} else { 599 is_ok(1 == $ob->write_drain); # 140 600} 601$tock=$ob->get_tick_count; 602 603$, = ""; 604$\ = ""; 605is_ok($pass == 1); # 141 606 607$err=$tock - $tick; 608is_bad (($err < 410) or ($err > 460)); # 142 609print "<425> elapsed time=$err\n"; 610 611$, = $ff; 612$\ = $rr; 613is_ok($ob->output_record_separator("") eq $r); # 143 614$tick=$ob->get_tick_count; 615$pass=print PORT $s, $s, $s; 616if ($SKIPDRAIN) { 617 is_zero(0); # 144 618 select(undef,undef,undef,0.475); 619} else { 620 is_ok(1 == $ob->write_drain); # 144 621} 622$tock=$ob->get_tick_count; 623 624$, = ""; 625$\ = ""; 626is_ok($pass == 1); # 145 627 628$err=$tock - $tick; 629is_bad (($err < 460) or ($err > 510)); # 146 630print "<475> elapsed time=$err\n"; 631 632is_ok($ob->output_field_separator($f) eq ""); # 147 633is_ok($ob->output_record_separator($r) eq ""); # 148 634 635 # tie to PRINTF method 636$tick=$ob->get_tick_count; 637if ( $] < 5.004 ) { 638 $out=sprintf "123456789_%s_987654321", $line; 639 $pass=print PORT $out; 640} 641else { 642 $pass=printf PORT "123456789_%s_987654321", $line; 643} 644if ($SKIPDRAIN) { 645 is_zero(0); # 149 646 select(undef,undef,undef,0.260); 647} else { 648 is_ok(1 == $ob->write_drain); # 149 649} 650$tock=$ob->get_tick_count; 651 652is_ok($pass == 1); # 150 653 654$err=$tock - $tick; 655is_bad (($err < 240) or ($err > 295)); # 151 656print "<260> elapsed time=$err\n"; 657 658is_ok($ob->output_field_separator("") eq $f); # 152 659is_ok($ob->output_record_separator("") eq $r); # 153 660 661 # destructor = CLOSE method 662if ( $] < 5.005 ) { 663 is_ok($ob->close); # 154 664} 665else { 666 is_ok(close PORT); # 154 667} 668 669 # destructor = DESTROY method 670undef $ob; # Don't forget this one!! 671untie *PORT; 672 673no strict 'subs'; 674is_ok(0xffffffff == LONGsize); # 155 675is_ok(0xffff == SHORTsize); # 156 676is_ok(0x1 == nocarp); # 157 677is_ok(0x0 == yes_true("F")); # 158 678is_ok(0x1 == yes_true("T")); # 159 679