diff options
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/runtest.libs/specs.test | 162 |
1 files changed, 162 insertions, 0 deletions
diff --git a/testsuite/runtest.libs/specs.test b/testsuite/runtest.libs/specs.test new file mode 100644 index 0000000..d6eac07 --- /dev/null +++ b/testsuite/runtest.libs/specs.test @@ -0,0 +1,162 @@ +# Test procedures in lib/specs.exp -*- Tcl -*- + +# Copyright (C) 2021 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. + +source $srcdir/$subdir/default_procs.tcl + +proc load_lib { lib } { + global srcdir + source $srcdir/../lib/$lib +} + +foreach lib { targetdb specs } { + source $srcdir/../lib/${lib}.exp +} + +# +# Create a false board config array +# +set board_info(baz,name) "baz" +set board_info(baz,ldscript) "-Tbaz.ld" +set board_info(quux,name) "quux" +set board_info(quux,ldscript) "-specs quux.specs" +set board_info(quux,other) "-mquux" + +::dejagnu::specs::load_specs test_specs { + one 1 + two 2 + three 3 + + percent {%%} + + base_test {%{two} %{one} %{three}} + esc_test_1 {%{two} %% %{three}} + esc_test_2 {%{one} %{percent} %{three}} + + + mapped/asc {%{one} %{two} %{three}} + mapped/desc {%{three} %{two} %{one}} + + mapped/ {%{mapped/asc}} + mapped_order asc + + map_test {%{mapped/%{mapped_order}}} + + + args {} + + call_test_1 {%[test_proc_1]} + call_test_2 {%[test_proc_2 %{args}]} + + + board {} + key {ldscript} + + board_test {%{board_info(%{board}):%{key}}} +} foo { + one 4 + three 6 +} bar { + two 8 + three 9 +} + +# test procedures for %[...] tests +proc test_proc_1 {} { return "test-1" } +proc test_proc_2 { args } { return "[llength $args]: $args" } + +# simple wrapper to bring global spec database into current scope +proc eval_specs { database_name goal options } { + global $database_name + ::dejagnu::specs::eval_specs $database_name $goal $options +} + +run_tests { + { "#" simple substitutions } + { lib_ret_test eval_specs {test_specs base_test {}} + {2 1 3} + "evaluate simple spec substitutions" } + { lib_ret_test eval_specs {test_specs base_test {one 5}} + {2 5 3} + "evaluate simple spec substitutions with option as override" } + { lib_ret_test eval_specs {test_specs esc_test_1 {}} + {2 % 3} + "evaluate simple spec substitutions with literal %" } + { lib_ret_test eval_specs {test_specs esc_test_2 {}} + {1 % 3} + "evaluate simple spec substitutions with literal % substituted" } + + { "#" layer search path } + { lib_ret_test eval_specs {test_specs base_test {_layers {foo}}} + {2 4 6} + "use layer 'foo'" } + { lib_ret_test eval_specs {test_specs base_test {_layers {bar}}} + {8 1 9} + "use layer 'bar'" } + { lib_ret_test eval_specs {test_specs base_test {_layers {foo bar}}} + {8 4 6} + "use layers 'foo' and 'bar'" } + { lib_ret_test eval_specs {test_specs base_test {_layers {bar foo}}} + {8 4 9} + "use layers 'bar' and 'foo'" } + + { "#" value-map substitutions } + { lib_ret_test eval_specs {test_specs map_test {}} + {1 2 3} + "mapped-value substitution as default" } + { lib_ret_test eval_specs {test_specs map_test {mapped_order desc}} + {3 2 1} + "mapped-value substitution with option as override" } + { lib_ret_test eval_specs {test_specs map_test {mapped_order ""}} + {1 2 3} + "mapped-value substitution with empty selector" } + { lib_errpat_test eval_specs {test_specs map_test {mapped_order bogus}} + {*mapped/bogus*} + "error if mapped value refers to non-existent spec string" } + + { "#" procedure-call substitutions } + { lib_ret_test eval_specs {test_specs call_test_1 {}} + {test-1} + "substitute arity 0 procedure call result" } + { lib_ret_test eval_specs {test_specs call_test_2 {}} + {0: } + "substitute procedure call result with no arguments" } + { lib_ret_test eval_specs {test_specs call_test_2 {args {%{base_test}}}} + {3: 2 1 3} + "substitute procedure call result with substituted arguments" } + { lib_ret_test eval_specs {test_specs call_test_2 {args {%%{one}}}} + {1: %{one}} + "substitutions not evaluated in procedure call result" } + + { "#" board_info substitutions } + { lib_ret_test eval_specs {test_specs board_test {board baz key other}} + {} + "empty result for non-existent key" } + { lib_ret_test eval_specs {test_specs board_test {board baz}} + {-Tbaz.ld} + "find 'ldscript' key for board 'baz'" } + { lib_ret_test eval_specs {test_specs board_test {board quux}} + {-specs quux.specs} + "find 'ldscript' key for board 'quux'" } + { lib_ret_test eval_specs {test_specs board_test {board quux key other}} + {-mquux} + "find 'other' key for board 'quux'" } +} + +puts "END specs.test" |