Commit bc5ab04a bc5ab04a7977653b2c8e4c8892be89fc0d941a26 by Sergey Poznyakoff

(mail_start): New flag -reuse-spool.

(default_mail_test): If command is empty do not send anything.
(mail_test_file): New function. Test the contents of an
arbitrary file.
1 parent 1852fb87
...@@ -133,7 +133,6 @@ proc default_mail_start {args} { ...@@ -133,7 +133,6 @@ proc default_mail_start {args} {
133 global expect_out 133 global expect_out
134 134
135 default_mail_version 135 default_mail_version
136 mail_prepare_spools
137 136
138 set sw $args 137 set sw $args
139 append sw " " 138 append sw " "
...@@ -174,7 +173,21 @@ proc default_mail_stop {} { ...@@ -174,7 +173,21 @@ proc default_mail_stop {} {
174 173
175 proc mail_start {args} { 174 proc mail_start {args} {
176 verbose "Starting mail" 175 verbose "Starting mail"
177 return [default_mail_start [lrange $args 0 end]] 176
177 set reuse_spool 0
178 for {set i 0} {$i < [llength $args]} {incr i} {
179 set a [lindex $args $i]
180 if {"$a" == "-reuse-spool"} {
181 set reuse_spool 1
182 } else {
183 break;
184 }
185 }
186
187 if {$reuse_spool == 0} {
188 mail_prepare_spools
189 }
190 return [default_mail_start [lrange $args $i end]]
178 } 191 }
179 192
180 proc mail_stop {} { 193 proc mail_stop {} {
...@@ -316,12 +329,14 @@ proc default_mail_test { args } { ...@@ -316,12 +329,14 @@ proc default_mail_test { args } {
316 } 329 }
317 330
318 set result -1 331 set result -1
332 if { "${command}" != "" } {
319 if { [mail_command "${command}"] != "" } { 333 if { [mail_command "${command}"] != "" } {
320 if { ! $do_suppress } { 334 if { ! $do_suppress } {
321 perror "Couldn't send \"$command\"."; 335 perror "Couldn't send \"$command\".";
322 } 336 }
323 return $result; 337 return $result;
324 } 338 }
339 }
325 340
326 if [info exists timeout] { 341 if [info exists timeout] {
327 set tmt $timeout; 342 set tmt $timeout;
...@@ -362,17 +377,10 @@ proc default_mail_test { args } { ...@@ -362,17 +377,10 @@ proc default_mail_test { args } {
362 } 377 }
363 } 378 }
364 379
365 mail_expect 30 {
366 -re "\[\r\n\]?${mail_prompt}$" {}
367 default {
368 perror "mail not initialized"
369 return 1
370 }
371 }
372 return $result 380 return $result
373 } 381 }
374 382
375 # mail_test [-message MESSAGE][-default (FAIL|XFAIL)] 383 # mail_test [-message MESSAGE][-default (FAIL|XFAIL)][-noprompt]
376 # COMMAND PATTERN [PATTERN...] 384 # COMMAND PATTERN [PATTERN...]
377 # COMMAND - Command to send to mail. 385 # COMMAND - Command to send to mail.
378 # PATTERN - Sequence to expect in return. 386 # PATTERN - Sequence to expect in return.
...@@ -385,6 +393,7 @@ proc mail_test { args } { ...@@ -385,6 +393,7 @@ proc mail_test { args } {
385 393
386 set default "" 394 set default ""
387 set message "" 395 set message ""
396 set wait_for_prompt 1
388 for {set i 0} {$i < [llength $args]} {incr i} { 397 for {set i 0} {$i < [llength $args]} {incr i} {
389 set a [lindex $args $i] 398 set a [lindex $args $i]
390 if {"$a" == "-default"} { 399 if {"$a" == "-default"} {
...@@ -393,6 +402,8 @@ proc mail_test { args } { ...@@ -393,6 +402,8 @@ proc mail_test { args } {
393 } elseif {"$a" == "-message"} { 402 } elseif {"$a" == "-message"} {
394 set message [lindex $args [expr $i + 1]] 403 set message [lindex $args [expr $i + 1]]
395 incr i 404 incr i
405 } elseif {"$a" == "-noprompt"} {
406 set wait_for_prompt 0
396 } else { 407 } else {
397 set args [lrange $args $i end] 408 set args [lrange $args $i end]
398 break 409 break
...@@ -409,6 +420,15 @@ proc mail_test { args } { ...@@ -409,6 +420,15 @@ proc mail_test { args } {
409 set command [lindex $args 0] 420 set command [lindex $args 0]
410 set pattern [lrange $args 1 end] 421 set pattern [lrange $args 1 end]
411 set result [default_mail_test $command $pattern] 422 set result [default_mail_test $command $pattern]
423 if {$wait_for_prompt} {
424 mail_expect 30 {
425 -re "\[\r\n\]?${mail_prompt}$" {}
426 default {
427 perror "mail not initialized"
428 return 1
429 }
430 }
431 }
412 432
413 if {$result == 0} { 433 if {$result == 0} {
414 pass "$message" 434 pass "$message"
...@@ -429,3 +449,60 @@ proc mail_test { args } { ...@@ -429,3 +449,60 @@ proc mail_test { args } {
429 return $result 449 return $result
430 } 450 }
431 451
452 proc mail_test_file {args} {
453 global verbose
454
455 set default ""
456 set message ""
457
458 for {set i 0} {$i < [llength $args]} {incr i} {
459 set a [lindex $args $i]
460 if {"$a" == "-default"} {
461 set default [lindex $args [expr $i + 1]]
462 incr i
463 } elseif {"$a" == "-message"} {
464 set message [lindex $args [expr $i + 1]]
465 incr i
466 } else {
467 set args [lrange $args $i end]
468 break
469 }
470 }
471
472 if {"$message" == ""} {
473 set message "Contents of [lindex $args 0]"
474 }
475
476 if $verbose>2 then {
477 send_user "Message is \"$message\"\n"
478 }
479
480 set filename [lindex $args 0]
481 set pattern [lrange $args 1 end]
482
483 set res [remote_spawn host "/bin/cat $filename"]
484 if { $res < 0 || $res == "" } {
485 perror "Reading $filename failed."
486 return 1;
487 }
488 set result [default_mail_test "" $pattern]
489 if {$result == 0} {
490 pass "$message"
491 } elseif {$result == 1} {
492 if { "$default" == "" || "$default" != "FAIL" } {
493 fail "$message"
494 } else {
495 xfail "$message"
496 set result 0
497 }
498 } elseif {$result == -2} {
499 fail "$message (timeout)"
500 } elseif {$result == -3} {
501 fail "$message (eof)"
502 } else {
503 fail "$message"
504 }
505 return $result
506 }
507
508
......