testsuite/runtest.libs/specs.test

   1 # Test procedures in lib/specs.exp                              -*- Tcl -*-
   2
   3 # Copyright (C) 2021 Free Software Foundation, Inc.
   4 #
   5 # This file is part of DejaGnu.
   6 #
   7 # DejaGnu is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # DejaGnu is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with DejaGnu; if not, write to the Free Software Foundation,
  19 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  20
  21 source $srcdir/$subdir/default_procs.tcl
  22
  23 proc load_lib { lib } {
  24     global srcdir
  25     source $srcdir/../lib/$lib
  26 }
  27
  28 foreach lib { targetdb specs } {
  29     source $srcdir/../lib/${lib}.exp
  30 }
  31
  32 #
  33 # Create a false board config array
  34 #
  35 set board_info(baz,name)        "baz"
  36 set board_info(baz,ldscript)    "-Tbaz.ld"
  37 set board_info(quux,name)       "quux"
  38 set board_info(quux,ldscript)   "-specs quux.specs"
  39 set board_info(quux,other)      "-mquux"
  40
  41 ::dejagnu::specs::load_specs test_specs {
  42     one         1
  43     two         2
  44     three       3
  45
  46     percent     {%%}
  47
  48     base_test   {%{two} %{one} %{three}}
  49     esc_test_1  {%{two} %% %{three}}
  50     esc_test_2  {%{one} %{percent} %{three}}
  51
  52
  53     mapped/asc  {%{one} %{two} %{three}}
  54     mapped/desc {%{three} %{two} %{one}}
  55
  56     mapped/     {%{mapped/asc}}
  57     mapped_order asc
  58
  59     map_test    {%{mapped/%{mapped_order}}}
  60
  61
  62     args        {}
  63
  64     call_test_1 {%[test_proc_1]}
  65     call_test_2 {%[test_proc_2 %{args}]}
  66
  67
  68     board       {}
  69     key         {ldscript}
  70
  71     board_test  {%{board_info(%{board}):%{key}}}
  72 } foo {
  73     one         4
  74     three       6
  75 } bar {
  76     two         8
  77     three       9
  78 }
  79
  80 # test procedures for %[...] tests
  81 proc test_proc_1 {} { return "test-1" }
  82 proc test_proc_2 { args } { return "[llength $args]: $args" }
  83
  84 # simple wrapper to bring global spec database into current scope
  85 proc eval_specs { database_name goal options } {
  86     global $database_name
  87     ::dejagnu::specs::eval_specs $database_name $goal $options
  88 }
  89
  90 run_tests {
  91     { "#" simple substitutions }
  92     { lib_ret_test eval_specs {test_specs base_test {}}
  93         {2 1 3}
  94         "evaluate simple spec substitutions" }
  95     { lib_ret_test eval_specs {test_specs base_test {one 5}}
  96         {2 5 3}
  97         "evaluate simple spec substitutions with option as override" }
  98     { lib_ret_test eval_specs {test_specs esc_test_1 {}}
  99         {2 % 3}
 100         "evaluate simple spec substitutions with literal %" }
 101     { lib_ret_test eval_specs {test_specs esc_test_2 {}}
 102         {1 % 3}
 103         "evaluate simple spec substitutions with literal % substituted" }
 104
 105     { "#" layer search path }
 106     { lib_ret_test eval_specs {test_specs base_test {_layers {foo}}}
 107         {2 4 6}
 108         "use layer 'foo'" }
 109     { lib_ret_test eval_specs {test_specs base_test {_layers {bar}}}
 110         {8 1 9}
 111         "use layer 'bar'" }
 112     { lib_ret_test eval_specs {test_specs base_test {_layers {foo bar}}}
 113         {8 4 6}
 114         "use layers 'foo' and 'bar'" }
 115     { lib_ret_test eval_specs {test_specs base_test {_layers {bar foo}}}
 116         {8 4 9}
 117         "use layers 'bar' and 'foo'" }
 118
 119     { "#" value-map substitutions }
 120     { lib_ret_test eval_specs {test_specs map_test {}}
 121         {1 2 3}
 122         "mapped-value substitution as default" }
 123     { lib_ret_test eval_specs {test_specs map_test {mapped_order desc}}
 124         {3 2 1}
 125         "mapped-value substitution with option as override" }
 126     { lib_ret_test eval_specs {test_specs map_test {mapped_order ""}}
 127         {1 2 3}
 128         "mapped-value substitution with empty selector" }
 129     { lib_errpat_test eval_specs {test_specs map_test {mapped_order bogus}}
 130         {*mapped/bogus*}
 131         "error if mapped value refers to non-existent spec string" }
 132
 133     { "#" procedure-call substitutions }
 134     { lib_ret_test eval_specs {test_specs call_test_1 {}}
 135         {test-1}
 136         "substitute arity 0 procedure call result" }
 137     { lib_ret_test eval_specs {test_specs call_test_2 {}}
 138         {0: }
 139         "substitute procedure call result with no arguments" }
 140     { lib_ret_test eval_specs {test_specs call_test_2 {args {%{base_test}}}}
 141         {3: 2 1 3}
 142         "substitute procedure call result with substituted arguments" }
 143     { lib_ret_test eval_specs {test_specs call_test_2 {args {%%{one}}}}
 144         {1: %{one}}
 145         "substitutions not evaluated in procedure call result" }
 146
 147     { "#" board_info substitutions }
 148     { lib_ret_test eval_specs {test_specs board_test {board baz key other}}
 149         {}
 150         "empty result for non-existent key" }
 151     { lib_ret_test eval_specs {test_specs board_test {board baz}}
 152         {-Tbaz.ld}
 153         "find 'ldscript' key for board 'baz'" }
 154     { lib_ret_test eval_specs {test_specs board_test {board quux}}
 155         {-specs quux.specs}
 156         "find 'ldscript' key for board 'quux'" }
 157     { lib_ret_test eval_specs {test_specs board_test {board quux key other}}
 158         {-mquux}
 159         "find 'other' key for board 'quux'" }
 160 }
 161
 162 puts "END specs.test"