lib/targetdb.exp

   1 # Copyright (C) 1992-2019, 2020 Free Software Foundation, Inc.
   2 #
   3 # This file is part of DejaGnu.
   4 #
   5 # DejaGnu is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # DejaGnu is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with DejaGnu; if not, write to the Free Software Foundation,
  17 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # Searches in the appropriate place (the board_info array) for the specified
  20 # information.
  21 #
  22 proc board_info { machine op args } {
  23     global target_info
  24     global board_info
  25
  26     verbose "board_info $machine $op $args" 3
  27
  28     if {[info exists target_info($machine,name)]} {
  29         set machine $target_info($machine,name)
  30     }
  31     if { $op eq "exists" } {
  32         if { [llength $args] == 0 } {
  33             return [info exists board_info($machine,name)]
  34         } else {
  35             return [info exists board_info($machine,[lindex $args 0])]
  36         }
  37     }
  38     if { [llength $args] == 0 } {
  39         verbose "getting $machine $op" 3
  40         if {[info exists board_info($machine,$op)]} {
  41             return $board_info($machine,$op)
  42         } else {
  43             return ""
  44         }
  45     }
  46     return ""
  47 }
  48
  49 proc target_info { op args } {
  50     return [eval "board_info target \"$op\" $args"]
  51 }
  52
  53 proc host_info { op args } {
  54     return [eval "board_info host \"$op\" $args"]
  55 }
  56
  57 # Set ENTRY to VALUE for the current board.
  58 #
  59 proc set_board_info { entry value } {
  60     global board_info board
  61     if {![info exists board_info($board,$entry)]} {
  62         set board_info($board,$entry) $value
  63     }
  64 }
  65
  66 #
  67 # Append VALUE to ENTRY for the current board.
  68 #
  69 proc add_board_info { entry value } {
  70     global board_info board
  71     lappend board_info($board,$entry) $value
  72 }
  73
  74 # Fill in ENTRY with VALUE for the current target.
  75 #
  76 proc set_currtarget_info { entry value } {
  77     global board_info
  78
  79     set board [target_info name]
  80
  81     if {![info exists board_info($board,$entry)]} {
  82         set board_info($board,$entry) $value
  83     }
  84 }
  85
  86 # Unset ENTRY for the current board being defined.
  87 #
  88 proc unset_board_info { entry } {
  89     global board_info board
  90
  91     if {[info exists board_info($board,$entry)]} {
  92         unset board_info($board,$entry)
  93     }
  94 }
  95
  96 # Unset ENTRY for the current board being defined.
  97 #
  98 proc unset_currtarget_info { entry } {
  99     global board_info
 100
 101     set board [target_info name]
 102
 103     if {[info exists board_info($board,$entry)]} {
 104         unset board_info($board,$entry)
 105     }
 106 }