xref: /openbmc/openbmc-test-automation/lib/source.tcl (revision ebef2f371745d650b26dccf5b4c5bbe9ddcecfed)
1*ebef2f37SMichael Walsh# This file is an aid in sourcing other tcl files.  It provides the following
2*ebef2f37SMichael Walsh# advantages:
3*ebef2f37SMichael Walsh# - It shortens the number of lines of code needed to intelligently source
4*ebef2f37SMichael Walsh# files.
5*ebef2f37SMichael Walsh# - Its my_source procedure provides several benefits (see my_source prolog
6*ebef2f37SMichael Walsh# below).
7*ebef2f37SMichael Walsh
8*ebef2f37SMichael Walsh# By convention, this file, or a link to this file, must exist in one of the
9*ebef2f37SMichael Walsh# directories named in the PATH environment variable.
10*ebef2f37SMichael Walsh
11*ebef2f37SMichael Walsh# Example use:
12*ebef2f37SMichael Walsh# source [exec bash -c "which source.tcl"]
13*ebef2f37SMichael Walsh# my_source [list print.tcl opt.tcl]
14*ebef2f37SMichael Walsh
15*ebef2f37SMichael Walshset path_list [split $::env(PATH) :]
16*ebef2f37SMichael Walsh
17*ebef2f37SMichael Walsh
18*ebef2f37SMichael Walshproc tcl_which { file_name } {
19*ebef2f37SMichael Walsh
20*ebef2f37SMichael Walsh  # Search the PATH environment variable for the first executable instance of
21*ebef2f37SMichael Walsh  # $file_name and return the full path.  On failure, return a blank string.
22*ebef2f37SMichael Walsh
23*ebef2f37SMichael Walsh  # This procedure runs much faster than [exec bash -c "which $file_name"].
24*ebef2f37SMichael Walsh
25*ebef2f37SMichael Walsh  # Description of argument(s):
26*ebef2f37SMichael Walsh  # file_name                       The name of the file to be found.
27*ebef2f37SMichael Walsh
28*ebef2f37SMichael Walsh  global path_list
29*ebef2f37SMichael Walsh
30*ebef2f37SMichael Walsh  foreach path $path_list {
31*ebef2f37SMichael Walsh    set file_path $path/$file_name
32*ebef2f37SMichael Walsh    if { [file executable $file_path] } { return $file_path }
33*ebef2f37SMichael Walsh  }
34*ebef2f37SMichael Walsh
35*ebef2f37SMichael Walsh  return ""
36*ebef2f37SMichael Walsh
37*ebef2f37SMichael Walsh}
38*ebef2f37SMichael Walsh
39*ebef2f37SMichael Walsh
40*ebef2f37SMichael Walshif { ![info exists sourced_files] } {
41*ebef2f37SMichael Walsh  set sourced_files [list]
42*ebef2f37SMichael Walsh}
43*ebef2f37SMichael Walsh
44*ebef2f37SMichael Walshproc my_source { source_files } {
45*ebef2f37SMichael Walsh
46*ebef2f37SMichael Walsh  # Source each file in the source_files list.
47*ebef2f37SMichael Walsh
48*ebef2f37SMichael Walsh  # This procedure provides the following benefits verses just using the
49*ebef2f37SMichael Walsh  # source command directly.
50*ebef2f37SMichael Walsh  # - Use of PATH environment variable to locate files.
51*ebef2f37SMichael Walsh  # - Better error handling.
52*ebef2f37SMichael Walsh  # - Will only source each file once.
53*ebef2f37SMichael Walsh  # - If "filex" is not found, this procedure will try to find "filex.tcl".
54*ebef2f37SMichael Walsh
55*ebef2f37SMichael Walsh  # Description of argument(s):
56*ebef2f37SMichael Walsh  # source_files                    A list of file names to be sourced.
57*ebef2f37SMichael Walsh
58*ebef2f37SMichael Walsh  global sourced_files
59*ebef2f37SMichael Walsh  global env
60*ebef2f37SMichael Walsh
61*ebef2f37SMichael Walsh  foreach file_name $source_files {
62*ebef2f37SMichael Walsh
63*ebef2f37SMichael Walsh    set file_path [tcl_which $file_name]
64*ebef2f37SMichael Walsh    if { $file_path == "" } {
65*ebef2f37SMichael Walsh      # Does the user specify a ".tcl" extension for this file?
66*ebef2f37SMichael Walsh      set tcl_ext [regexp -expanded {\.tcl$} $file_name]
67*ebef2f37SMichael Walsh      if { $tcl_ext } {
68*ebef2f37SMichael Walsh        append message "**ERROR** Programmer error - Failed to find"
69*ebef2f37SMichael Walsh        append message " \"${file_name}\" source file:\n"
70*ebef2f37SMichael Walsh        append message $::env(PATH)
71*ebef2f37SMichael Walsh        puts stderr $message
72*ebef2f37SMichael Walsh        exit 1
73*ebef2f37SMichael Walsh      }
74*ebef2f37SMichael Walsh
75*ebef2f37SMichael Walsh      set file_path [tcl_which ${file_name}.tcl]
76*ebef2f37SMichael Walsh      if { $file_path == "" } {
77*ebef2f37SMichael Walsh        append message "**ERROR** Programmer error - Failed to find either"
78*ebef2f37SMichael Walsh        append message " \"${file_name}\" or \"${file_name}.tcl\" source file:"
79*ebef2f37SMichael Walsh        append message $::env(PATH)
80*ebef2f37SMichael Walsh        puts stderr $message
81*ebef2f37SMichael Walsh        exit 1
82*ebef2f37SMichael Walsh      }
83*ebef2f37SMichael Walsh    }
84*ebef2f37SMichael Walsh
85*ebef2f37SMichael Walsh    # Adjust name (in case we found the .tcl version of a file).
86*ebef2f37SMichael Walsh    set full_file_name "[file tail $file_path]"
87*ebef2f37SMichael Walsh
88*ebef2f37SMichael Walsh    # Have we already attempted to source this file?
89*ebef2f37SMichael Walsh    if { [lsearch -exact $sourced_files $full_file_name] != -1 } { continue }
90*ebef2f37SMichael Walsh    # Add the file name to the list of sourced files.  It is important to add
91*ebef2f37SMichael Walsh    # this file to the list BEFORE we source the file.  Otherwise, if there is
92*ebef2f37SMichael Walsh    # a recursive source (a sources b, b sources c, c sources a), we will get
93*ebef2f37SMichael Walsh    # into an infinite loop.
94*ebef2f37SMichael Walsh    lappend sourced_files $full_file_name
95*ebef2f37SMichael Walsh
96*ebef2f37SMichael Walsh    if { [catch { uplevel 1 source $file_path } result] } {
97*ebef2f37SMichael Walsh      append message "**ERROR** Programmer error - Failed to source"
98*ebef2f37SMichael Walsh      append message " \"${file_path}\":\n${result}"
99*ebef2f37SMichael Walsh      puts stderr $message
100*ebef2f37SMichael Walsh
101*ebef2f37SMichael Walsh      exit 1
102*ebef2f37SMichael Walsh    }
103*ebef2f37SMichael Walsh  }
104*ebef2f37SMichael Walsh
105*ebef2f37SMichael Walsh}
106