# Time-stamp: <modified the 22/08/2014 (at 13:42) by Erwan Jahier>
#
# (nonreg-)test harness main file
set testdir [pwd]
set lus2lic "./lus2lic"
set ec2c "./ec2c"
set ec2c "./myec2c"
set test_lus2lic_no_node "$testdir/../utils/test_lus2lic_no_node"
set compare_exec_and_2c "$testdir/../utils/compare_exec_and_2c"
set timeout 10
proc should_work { test_name command_line args } {
global verbose
set cl [file tail $command_line]
set cl $command_line
set failed 0
# When verbose, tell the user what we are running
if { $verbose > 1 } {
send_user "starting $command_line\n"
}
# Running the program.
eval spawn $command_line {*}$args
set pid [exp_pid]
puts "PID: $pid ($command_line $args)"
expect {
# Check for any warning messages in the output first
Warning {
set failed 0
exp_continue
}
Error {
set failed 1
exp_continue
}
"ec program must contain a single node" {
set failed 1
exp_continue
}
"unexpected operator: " {
set failed 1
exp_continue
}
"error" {
set failed 1
exp_continue
}
"ERROR" {
set failed 1
exp_continue
}
"oops: an internal" {
set failed 1
exp_continue
}
"undeclared ident" {
set failed 1
exp_continue
}
"egmentation fault" {
set failed 1
exp_continue
}
"rdbg -lurette: ok" {
pass "$cl $args"
}
"lurettetop ok" {
pass "$cl $args"
}
# to avoid that match_max (the expect buffer size) is reached
# which truncate the outputs
"\n" {
exp_continue
}
eof {
if $failed {
fail "$test_name: $cl $args"
} else {
pass "$cl $args"
}
}
# Timeout requires inspection to determine the cause of failure.
timeout {
unresolved "Time out: $cl $args"
}
}
return $spawn_id
}
proc should_fail { test_name fail_kind command_line args } {
global verbose
set failed 0
set cl [file tail $command_line]
# When verbose, tell the user what we are running
if { $verbose > 1 } {
send_user "starting $cl\n"
}
# Running the program.
eval spawn $command_line {*}$args
expect {
"oops: an internal" {
expect eof
fail "$test_name ($fail_kind): $cl $args"
}
Error {
set failed 1
exp_continue
}
"\n" {
exp_continue
}
eof {
if $failed {
xfail "$test_name ($fail_kind): $cl $args"
} else {
xpass "$test_name ($fail_kind): $cl $args"
}
}
timeout {
unresolved "Time out $test_name ($fail_kind): $cl $args"
exit
}
}
return $spawn_id
}
proc nonemptyfile {filename} {
set rc [catch {file size $filename} size]
return [expr {$rc == 0 && $size > 0}]
}
package require fileutil
# test if file $f contain the string $str
proc does_not_contain_string {f str} {
set occ [llength [fileutil::grep $str $f]]
if { ($occ == 1 ) } { puts " $f contains $occ occurence of $str" }
if { ($occ > 1 ) } { puts " $f contains $occ occurence(s) of $str" }
return [expr { $occ == 0 }]
}
# do no try to use lurette on files that contains extern nodes or package.
# Package won't work because appending the tested lustre file with the
# generated oracle as I do is wrong in presence of package (fixme)
proc do_ecexe_vs_exec {f} {
if {
[does_not_contain_string "$f" "enum "] &&
[does_not_contain_string "$f" "extern"] &&
[does_not_contain_string "$f" "package"]
} {
return 1
}
return 0
}
proc do_2c_vs_exec {f} {
if {
[does_not_contain_string "$f" "extern"] &&
[does_not_contain_string "$f" "package"]
} {
return 1
}
return 0
}
# not robust to race...
proc get_free_port {} {
set sock [socket -server localhost 0]
set l [fconfigure $sock -sockname]
set port [lindex $l 2]
close $sock
return $port
}
proc port_used {port} {
if { [catch {set sock [socket -server localhost $port] }]} {
return 1
} else {
close $sock
return 0
}
}
proc get_next_free_port {port} {
while { [port_used $port] } {
set port [expr "$port + 1"]
}
return $port
}
proc nonreg_exec_and_2c {files tmp} {
global lus2lic
global compare_exec_and_2c
foreach f $files {
eval spawn "cp -f $f $tmp"
}
cd $tmp
foreach f $files {
set port [get_free_port]
set f_no_ext [file rootname $f]
set bf [file tail $f_no_ext]
set f [file tail $f]
set node [file tail $f_no_ext]
set id1 [should_work "Generate c code " "$lus2lic" "-2c $f -n $node"]
wait -i $id1
if { [nonemptyfile "${node}_${node}.c"] } {
eval spawn "rm -f a.out"
if { [nonemptyfile "${node}_${node}_ext.c"] } {
set id2 [should_work "Check that the generated C code compiles " \
"gcc ${node}_${node}.c ${node}_${node}_ext.c ${node}_${node}_loop.c"]
} else {
set id2 [should_work "Check that the generated C code compiles " \
"gcc ${node}_${node}.c ${node}_${node}_loop.c"]
}
wait -i $id2
catch { exp_close -i $id2 }
catch { exp_wait -i $id2 } output
if { [nonemptyfile a.out] && [do_2c_vs_exec "$f"] } {
set id3 [should_work "Try to compare lus2lic -exec and -2c" \
"$compare_exec_and_2c" "$f" "$port"]
catch { exp_close -i $id3 }
catch { exp_wait -i $id3 } output
}
}
catch { exp_close -i $id1 }
catch { exp_wait -i $id1 } output
}
return 0
}
proc nonreg_exec_and_ecexe {files tmp} {
global lus2lic
global ec2c
global test_lus2lic_no_node
foreach f $files {
eval spawn "cp -f $f $tmp"
}
cd $tmp
foreach f $files {
set port [get_free_port]
set f_no_ext [file rootname $f]
set bf [file tail $f_no_ext]
set f [file tail $f]
set node [file tail $f_no_ext]
set id1 [should_work "without any option" "$lus2lic" "-o $bf.lic $f"]
wait -i $id1
if { [nonemptyfile "$bf.lic"] } {
set id2 [should_work "Generate ec code " "$lus2lic" "-ec -o $bf.ec $f"]
wait -i $id2
if { [nonemptyfile "$bf.ec"] } {
set id3 [should_work "Try ec2c on the result" "$ec2c" "-o $bf.c $bf.ec"]
wait -i $id3
catch { exp_close -i $id3 }
catch { exp_wait -i $id3 } output
}
if { [nonemptyfile "$bf.c"] && [do_ecexe_vs_exec "$f"] } {
set id4 [should_work "Try to compare lus2lic -exec and ecexe" \
"$test_lus2lic_no_node" "$f" "$port"]
catch { exp_close -i $id4 }
catch { exp_wait -i $id4 } output
}
catch { exp_close -i $id2 }
catch { exp_wait -i $id2 } output
}
catch { exp_close -i $id1 }
catch { exp_wait -i $id1 } output
}
return 0
}