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