OXYGENHUB
◆ main openmsx / share / scripts / _test_machines_and_extensions.tcl
3.2 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 1 
# TCL script for openMSX for easy testing of known machines and extensions.
2 
# (c) 2012 Filip H.F. "FiXato" Slagter
3 
# For inclusion with openMSX, GNU General Public License version 2 (GPLv2,
4 
# http://www.gnu.org/licenses/gpl-2.0.html) applies.
5 
# Otherwise you may use this work without restrictions, as long as this notice
6 
# is included.
7 
# The work is provided "as is" without warranty of any kind, neither express
8 
# nor implied.
9
10 
set_help_text test_all_machines "Test all known machines and report errors. Pass 'stderr' as channel argument to get the return values on the commandline."
11
12 
proc test_all_machines {{channel "stdout"}} {
13 
	set nof_machines [llength [openmsx_info machines]]
14 
	set broken [list]
15 
	set errors [list]
16 
	puts $channel "Going to test $nof_machines machines..."
17 
	foreach machine [openmsx_info machines] {
18 
		puts -nonewline $channel "Testing $machine ([utils::get_machine_display_name_by_config_name $machine])... "
19 
		set res [test_machine $machine]
20 
		if {$res != ""} {
21 
			lappend broken $machine
22 
			lappend errors $res
23 
			set res "BROKEN: $res"
24 
		} else {
25 
			set res "OK"
26 
		}
27 
		puts $channel $res
28 
	}
29 
	set nof_ok [expr {$nof_machines - [llength $broken]}]
30 
	set perc [expr {($nof_ok*100)/$nof_machines}]
31 
	puts $channel ""
32 
	puts $channel "$nof_ok out of $nof_machines machines OK ($perc\%)"
33 
	if {$nof_ok < $nof_machines} {
34 
		puts $channel ""
35 
		puts $channel "Broken machines:"
36 
		foreach machine $broken errormsg $errors {
37 
			puts $channel "  $machine ([utils::get_machine_display_name_by_config_name $machine]): $errormsg"
38 
		}
39 
	}
40 
}
41
42 
set_help_text test_all_extensions "Test all known extensions and report errors. Defaults to using your current machine profile. You can optionally specify another machine configuration name to test on that profile. Pass 'stderr' as last argument to get the return values on the commandline."
43
44 
proc test_all_extensions {{machine ""} {channel "stdout"}} {
45
46 
	if {$machine == ""} {
47 
		set machine [machine_info config_name]
48 
	}
49
50 
	# Start a new machine to prevent any conflicts
51 
	machine $machine
52
53 
	set nof_extensions [llength [openmsx_info extensions]]
54 
	set broken [list]
55 
	set errors [list]
56 
	puts $channel "Going to test $nof_extensions extensions on machine \"[utils::get_machine_display_name_by_config_name $machine]\"..."
57 
	foreach extension [openmsx_info extensions] {
58 
		# Try to plug in the extension and output any errors to the
59 
		# given channel (defaults to stdout aka the openMSX console)
60 
		puts -nonewline $channel "Testing $extension ([utils::get_extension_display_name_by_config_name $extension])... "
61 
		set res ""
62 
		if { [catch {ext $extension} errorText] } {
63 
			lappend broken $extension
64 
			lappend errors $errorText
65 
			set res "BROKEN: $errorText"
66 
		} else {
67 
			set res "OK"
68 
			incr nof_ok
69 
			remove_extension $extension
70 
		}
71 
		puts $channel $res
72 
	}
73 
	set nof_ok [expr {$nof_extensions - [llength $broken]}]
74 
	set perc [expr {($nof_ok*100)/$nof_extensions}]
75 
	puts $channel ""
76 
	puts $channel "$nof_ok out of $nof_extensions extensions OK ($perc\%)"
77 
	if {$nof_ok < $nof_extensions} {
78 
		puts $channel ""
79 
		puts $channel "Broken extensions:"
80 
		foreach extension $broken errormsg $errors {
81 
			puts $channel "  $extension ([utils::get_extension_display_name_by_config_name $extension]): $errormsg"
82 
		}
83 
	}
84 
}