testsuite/report-card.all/passes.exp - dejagnu - Git at Google

 # Copyright (C) 2018, 2024 Free Software Foundation, Inc.
 #
 # This file is part of DejaGnu.
 #
 # DejaGnu is free software; you can redistribute it and/or modify it
 # under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 3 of the License, or
 # (at your option) any later version.
 #
 # DejaGnu is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
 #
 # You should have received a copy of the GNU General Public License
 # along with DejaGnu; if not, write to the Free Software Foundation,
 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.

 # This file was written by Jacob Bachmeyer.

 load_lib bohman_ssd.exp

 set header_column_names { PASS FAIL ?PASS ?FAIL UNSUP UNRES UNTEST }
 set result_column_map {
     PASS FAIL { KPASS XPASS } { KFAIL XFAIL }
     UNSUPPORTED UNRESOLVED UNTESTED
 }

 set test_results { PASS FAIL KPASS KFAIL XPASS XFAIL
 		   UNSUPPORTED UNRESOLVED UNTESTED }

 set stty_init { -onlcr }

 # each entry: { {mode n} { suffix_tag... } { pass... } { { result name }... } }
 array unset tuplemap
 array set tuplemap {
     basic	{ {S  3} { a b } { foo bar }
 	{ { PASS pass } { FAIL fail } } }
     kxpass	{ {S  2} { a b } { foo bar }
 	{ { KPASS kpass } { XPASS xpass } } }
     kxfail	{ {Sp 2} { a b } { foo bar }
 	{ { KFAIL kfail } { XFAIL xfail } } }
     unresult	{ {S  2} { a b } { foo bar }
 	{ { UNSUPPORTED unsupported }
 	    { UNRESOLVED unresolved } { UNTESTED untested } } }
 }

 # Given: TUPLES: { { result ... }... }, PASSES: { pass... }
 # Return: Cartesian product TUPLES x PASSES: { { result pass ... }... }
 proc build_tuple_list { tuples passes } {
     set result [list]
     foreach cell $tuples {
 	foreach pass $passes {
 	    lappend result [linsert $cell 1 $pass]
 	}
     }
     return $result
 }

 # Given: TUPLES: { { result pass name }... }, MODE: S | Sp, N
 # Return: { { result pass name count }... } where COUNT is from an SSD-set
 proc annotate_tuple_list { tuples mode n } {
     set m [llength $tuples]
     set ssd [switch -- $mode {
 	S  { ::math_utils::Bohman_SSD::S  $n $m }
 	Sp { ::math_utils::Bohman_SSD::Sp $n $m }
     }]
     set result [list]
     foreach cell $tuples ssdterm $ssd {
 	lappend result [linsert $cell end $ssdterm]
     }
     return $result
 }

 # Given: TUPLES: { { result pass name count }... }; (RESULT,PASS) not unique
 # Return: { { result pass expected_total }... } where (RESULT,PASS) is unique
 proc compute_expected_pass_totals { tuples } {
     foreach cell $tuples {  set count([lrange $cell 0 1]) 0 }
     foreach cell $tuples { incr count([lrange $cell 0 1]) [lindex $cell 3] }
     set result [list]
     foreach name [lsort [array names count]] {
 	lappend result [concat $name $count($name)]
     }
     return $result
 }

 # Given: TUPLES: { { result pass name count }... }; (RESULT,PASS) not unique
 # Return: { { result expected_grand_total }... }
 proc compute_expected_grand_totals { tuples } {
     foreach cell $tuples {  set count([lindex $cell 0]) 0 }
     foreach cell $tuples { incr count([lindex $cell 0]) [lindex $cell 3] }
     set result [list]
     foreach name [lsort [array names count]] {
 	lappend result [list $name $count($name)]
     }
     return $result
 }

 # Given: TUPLES: { { result pass ... }... } where (RESULT,PASS) repeats later
 # Return: { { { result pass ... }... }... }; (RESULT,PASS) unique per sublist
 proc split_tuple_list { tuples } {
     set result [list]
     set sublist [list]
     foreach cell $tuples {
 	if { [info exists seen([lrange $cell 0 1])] } {
 	    # split here
 	    lappend result $sublist
 	    set sublist [list]
 	    array unset seen
 	}
 	lappend sublist $cell
 	set seen([lrange $cell 0 1]) 1
     }
     lappend result $sublist
     return $result
 }

 # TUPLES is: { { result pass name count }... }
 proc write_file { basename tuples } {
     set fd [open [testsuite file -object -test passes ${basename}.sum] w]
     set pass {}
     foreach cell [lsort -index 1 $tuples] {
 	if { $pass ne [lindex $cell 1] } {
 	    puts $fd "Running pass `[lindex $cell 1]' ..."
 	    set pass [lindex $cell 1]
 	}
 	for { set i 1 } { $i <= [lindex $cell 3] } { incr i } {
 	    puts $fd "[lindex $cell 0]: [lindex $cell 1]:\
 			[lindex $cell 2] test ${i}/[lindex $cell 3]"
 	}
     }
     close $fd
 }

 proc run_multipass_output_test { filetag } {
     global LAUNCHER
     global header_column_names
     global result_column_map
     global test_results
     global tuplemap

     set ssdpar	[lindex $tuplemap($filetag) 0]
     set tags	[lindex $tuplemap($filetag) 1]
     set passes	[lindex $tuplemap($filetag) 2]
     set results	{}
     foreach dummy $tags { lappend results [lindex $tuplemap($filetag) 3] }
     set results [join $results]

     # initialize totals arrays to zero
     foreach result $test_results { set have_grand_totals($result) 0 }
     array set want_grand_totals [array get have_grand_totals]
     foreach cell [build_tuple_list $test_results $passes] {
 	set have_pass_totals([join [lrange $cell 0 1] ","]) 0
     }
     array set want_pass_totals [array get have_pass_totals]

     # get the test list
     set list [build_tuple_list $results $passes]
     set list [annotate_tuple_list $list [lindex $ssdpar 0] [lindex $ssdpar 1]]

     # compute expected totals
     #  note that this only fills non-zero array positions
     foreach cell [compute_expected_pass_totals $list] {
 	set want_pass_totals([join [lrange $cell 0 1] ","]) [lindex $cell 2]
     }
     array set want_grand_totals [join [compute_expected_grand_totals $list]]

     # write the test data files and store expected per-file counts
     foreach tag $tags fileset [split_tuple_list $list] {
 	# write test file
 	write_file "${filetag}-${tag}" $fileset
 	# initialize test results for this file
 	foreach result $test_results {
 	    foreach pass $passes {
 		set want_file_counts(${filetag}-${tag},$result,$pass) 0
 		set have_file_counts(${filetag}-${tag},$result,$pass) 0
 	    }
 	}
 	# store expected results for this file
 	foreach cell $fileset {
 	    set want_file_counts(${filetag}-${tag},[join [lrange $cell 0 1] \
 							","]) [lindex $cell 3]
 	}
     }

     # run the dejagnu-report-card tool
     set separator_count 0
     spawn /bin/sh -c \
 	"cd [testsuite file -object -test passes]\
 	 && exec $LAUNCHER report-card ${filetag}-*.sum"

     # skip header
     expect {
 	-re {^[[:space:]]+_+[\r\n]+} { exp_continue }
 	-re {^[[:space:]]+/([^\r\n]*)[\r\n]+} { exp_continue }
 	-re {^[[:space:]]+\|-+[\r\n]+} { incr separator_count }
     }

     # read individual file lines
     set re_file_row {^[[:space:]]*}
     append re_file_row {(} $filetag {-[[:alpha:]]+)[[:space:]]+}
     append re_file_row {/[[:space:]]+([[:alpha:]]+)[[:space:]]+\|}
     append re_file_row {[[:space:]]*([[:digit:][:space:]]+)[\r\n]+}
     expect {
 	-re $re_file_row {
 	    foreach column $result_column_map colname $header_column_names \
 		have $expect_out(3,string) {
 		    set want 0
 		    foreach rs $column {
 			set tmp $expect_out(1,string),$rs,$expect_out(2,string)
 			incr want $want_file_counts($tmp)
 		    }
 		    if { $have == $want } {
 			pass "count $colname\
 			      for pass $expect_out(2,string)\
 			      in file $expect_out(1,string)"
 		    } else {
 			fail "count $colname\
 			      for pass $expect_out(2,string)\
 			      in file $expect_out(1,string)"
 		    }
 		}
 	    exp_continue
 	}
 	-re {^[[:space:]]+\|-+[\r\n]+} { incr separator_count }
     }

     # read pass totals lines
     set re_pass_row {^[[:space:]]+([[:alpha:]]+)[[:space:]]+\|}
     append re_pass_row {[[:space:]]*([[:digit:][:space:]]+)[\r\n]+}
     expect {
 	-re $re_pass_row {
 	    foreach column $result_column_map colname $header_column_names \
 		have $expect_out(2,string) {
 		    set want 0
 		    foreach rs $column {
 			incr want $want_pass_totals($rs,$expect_out(1,string))
 		    }
 		    if { $have == $want } {
 			pass "total $colname for pass $expect_out(1,string)"
 		    } else {
 			fail "total $colname for pass $expect_out(1,string)"
 		    }
 		}
 	    exp_continue
 	}
 	-re {^[[:space:]]+\|-+[\r\n]+} { incr separator_count }
     }

     # read grand totals line
     expect -re {^[[:space:]]+\|[[:space:]]*([[:digit:][:space:]]+)[\r\n]+} {
 	foreach column $result_column_map colname $header_column_names \
 	    have $expect_out(1,string) {
 		set want 0
 		foreach rs $column { incr want $want_grand_totals($rs) }
 		if { $have == $want } {
 		    pass "grand total $colname"
 		} else {
 		    fail "grand total $colname"
 		}
 	    }
     }

     # skip the footer
     expect -re {.+} { exp_continue }

     if { $separator_count == 3 } {
 	pass "expected separator lines"
     } else {
 	fail "expected separator lines"
     }
 }

 foreach filetag [lsort [array names tuplemap]] {
     run_multipass_output_test $filetag
 }

 #EOF
	# Copyright (C) 2018, 2024 Free Software Foundation, Inc.
	#
	# This file is part of DejaGnu.
	#
	# DejaGnu is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 3 of the License, or
	# (at your option) any later version.
	#
	# DejaGnu is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	# General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with DejaGnu; if not, write to the Free Software Foundation,
	# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.

	# This file was written by Jacob Bachmeyer.

	load_lib bohman_ssd.exp

	set header_column_names { PASS FAIL ?PASS ?FAIL UNSUP UNRES UNTEST }
	set result_column_map {
	PASS FAIL { KPASS XPASS } { KFAIL XFAIL }
	UNSUPPORTED UNRESOLVED UNTESTED
	}

	set test_results { PASS FAIL KPASS KFAIL XPASS XFAIL
	UNSUPPORTED UNRESOLVED UNTESTED }

	set stty_init { -onlcr }

	# each entry: { {mode n} { suffix_tag... } { pass... } { { result name }... } }
	array unset tuplemap
	array set tuplemap {
	basic { {S 3} { a b } { foo bar }
	{ { PASS pass } { FAIL fail } } }
	kxpass { {S 2} { a b } { foo bar }
	{ { KPASS kpass } { XPASS xpass } } }
	kxfail { {Sp 2} { a b } { foo bar }
	{ { KFAIL kfail } { XFAIL xfail } } }
	unresult { {S 2} { a b } { foo bar }
	{ { UNSUPPORTED unsupported }
	{ UNRESOLVED unresolved } { UNTESTED untested } } }
	}

	# Given: TUPLES: { { result ... }... }, PASSES: { pass... }
	# Return: Cartesian product TUPLES x PASSES: { { result pass ... }... }
	proc build_tuple_list { tuples passes } {
	set result [list]
	foreach cell $tuples {
	foreach pass $passes {
	lappend result [linsert $cell 1 $pass]
	}
	}
	return $result
	}

	# Given: TUPLES: { { result pass name }... }, MODE: S \| Sp, N
	# Return: { { result pass name count }... } where COUNT is from an SSD-set
	proc annotate_tuple_list { tuples mode n } {
	set m [llength $tuples]
	set ssd [switch -- $mode {
	S { ::math_utils::Bohman_SSD::S $n $m }
	Sp { ::math_utils::Bohman_SSD::Sp $n $m }
	}]
	set result [list]
	foreach cell $tuples ssdterm $ssd {
	lappend result [linsert $cell end $ssdterm]
	}
	return $result
	}

	# Given: TUPLES: { { result pass name count }... }; (RESULT,PASS) not unique
	# Return: { { result pass expected_total }... } where (RESULT,PASS) is unique
	proc compute_expected_pass_totals { tuples } {
	foreach cell $tuples { set count([lrange $cell 0 1]) 0 }
	foreach cell $tuples { incr count([lrange $cell 0 1]) [lindex $cell 3] }
	set result [list]
	foreach name [lsort [array names count]] {
	lappend result [concat $name $count($name)]
	}
	return $result
	}

	# Given: TUPLES: { { result pass name count }... }; (RESULT,PASS) not unique
	# Return: { { result expected_grand_total }... }
	proc compute_expected_grand_totals { tuples } {
	foreach cell $tuples { set count([lindex $cell 0]) 0 }
	foreach cell $tuples { incr count([lindex $cell 0]) [lindex $cell 3] }
	set result [list]
	foreach name [lsort [array names count]] {
	lappend result [list $name $count($name)]
	}
	return $result
	}

	# Given: TUPLES: { { result pass ... }... } where (RESULT,PASS) repeats later
	# Return: { { { result pass ... }... }... }; (RESULT,PASS) unique per sublist
	proc split_tuple_list { tuples } {
	set result [list]
	set sublist [list]
	foreach cell $tuples {
	if { [info exists seen([lrange $cell 0 1])] } {
	# split here
	lappend result $sublist
	set sublist [list]
	array unset seen
	}
	lappend sublist $cell
	set seen([lrange $cell 0 1]) 1
	}
	lappend result $sublist
	return $result
	}

	# TUPLES is: { { result pass name count }... }
	proc write_file { basename tuples } {
	set fd [open [testsuite file -object -test passes ${basename}.sum] w]
	set pass {}
	foreach cell [lsort -index 1 $tuples] {
	if { $pass ne [lindex $cell 1] } {
	puts $fd "Running pass `[lindex $cell 1]' ..."
	set pass [lindex $cell 1]
	}
	for { set i 1 } { $i <= [lindex $cell 3] } { incr i } {
	puts $fd "[lindex $cell 0]: [lindex $cell 1]:\
	[lindex $cell 2] test ${i}/[lindex $cell 3]"
	}
	}
	close $fd
	}

	proc run_multipass_output_test { filetag } {
	global LAUNCHER
	global header_column_names
	global result_column_map
	global test_results
	global tuplemap

	set ssdpar [lindex $tuplemap($filetag) 0]
	set tags [lindex $tuplemap($filetag) 1]
	set passes [lindex $tuplemap($filetag) 2]
	set results {}
	foreach dummy $tags { lappend results [lindex $tuplemap($filetag) 3] }
	set results [join $results]

	# initialize totals arrays to zero
	foreach result $test_results { set have_grand_totals($result) 0 }
	array set want_grand_totals [array get have_grand_totals]
	foreach cell [build_tuple_list $test_results $passes] {
	set have_pass_totals([join [lrange $cell 0 1] ","]) 0
	}
	array set want_pass_totals [array get have_pass_totals]

	# get the test list
	set list [build_tuple_list $results $passes]
	set list [annotate_tuple_list $list [lindex $ssdpar 0] [lindex $ssdpar 1]]

	# compute expected totals
	# note that this only fills non-zero array positions
	foreach cell [compute_expected_pass_totals $list] {
	set want_pass_totals([join [lrange $cell 0 1] ","]) [lindex $cell 2]
	}
	array set want_grand_totals [join [compute_expected_grand_totals $list]]

	# write the test data files and store expected per-file counts
	foreach tag $tags fileset [split_tuple_list $list] {
	# write test file
	write_file "${filetag}-${tag}" $fileset
	# initialize test results for this file
	foreach result $test_results {
	foreach pass $passes {
	set want_file_counts(${filetag}-${tag},$result,$pass) 0
	set have_file_counts(${filetag}-${tag},$result,$pass) 0
	}
	}
	# store expected results for this file
	foreach cell $fileset {
	set want_file_counts(${filetag}-${tag},[join [lrange $cell 0 1] \
	","]) [lindex $cell 3]
	}
	}

	# run the dejagnu-report-card tool
	set separator_count 0
	spawn /bin/sh -c \
	"cd [testsuite file -object -test passes]\
	&& exec $LAUNCHER report-card ${filetag}-*.sum"

	# skip header
	expect {
	-re {^[[:space:]]+_+[\r\n]+} { exp_continue }
	-re {^[[:space:]]+/([^\r\n]*)[\r\n]+} { exp_continue }
	-re {^[[:space:]]+\\|-+[\r\n]+} { incr separator_count }
	}

	# read individual file lines
	set re_file_row {^[[:space:]]*}
	append re_file_row {(} $filetag {-[[:alpha:]]+)[[:space:]]+}
	append re_file_row {/[[:space:]]+([[:alpha:]]+)[[:space:]]+\\|}
	append re_file_row {[[:space:]]*([[:digit:][:space:]]+)[\r\n]+}
	expect {
	-re $re_file_row {
	foreach column $result_column_map colname $header_column_names \
	have $expect_out(3,string) {
	set want 0
	foreach rs $column {
	set tmp $expect_out(1,string),$rs,$expect_out(2,string)
	incr want $want_file_counts($tmp)
	}
	if { $have == $want } {
	pass "count $colname\
	for pass $expect_out(2,string)\
	in file $expect_out(1,string)"
	} else {
	fail "count $colname\
	for pass $expect_out(2,string)\
	in file $expect_out(1,string)"
	}
	}
	exp_continue
	}
	-re {^[[:space:]]+\\|-+[\r\n]+} { incr separator_count }
	}

	# read pass totals lines
	set re_pass_row {^[[:space:]]+([[:alpha:]]+)[[:space:]]+\\|}
	append re_pass_row {[[:space:]]*([[:digit:][:space:]]+)[\r\n]+}
	expect {
	-re $re_pass_row {
	foreach column $result_column_map colname $header_column_names \
	have $expect_out(2,string) {
	set want 0
	foreach rs $column {
	incr want $want_pass_totals($rs,$expect_out(1,string))
	}
	if { $have == $want } {
	pass "total $colname for pass $expect_out(1,string)"
	} else {
	fail "total $colname for pass $expect_out(1,string)"
	}
	}
	exp_continue
	}
	-re {^[[:space:]]+\\|-+[\r\n]+} { incr separator_count }
	}

	# read grand totals line
	expect -re {^[[:space:]]+\\|[[:space:]]*([[:digit:][:space:]]+)[\r\n]+} {
	foreach column $result_column_map colname $header_column_names \
	have $expect_out(1,string) {
	set want 0
	foreach rs $column { incr want $want_grand_totals($rs) }
	if { $have == $want } {
	pass "grand total $colname"
	} else {
	fail "grand total $colname"
	}
	}
	}

	# skip the footer
	expect -re {.+} { exp_continue }

	if { $separator_count == 3 } {
	pass "expected separator lines"
	} else {
	fail "expected separator lines"
	}
	}

	foreach filetag [lsort [array names tuplemap]] {
	run_multipass_output_test $filetag
	}

	#EOF