# Copyright (C) 92, 93, 94, 95, 1996 Free Software Foundation, Inc.

# This program 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 2 of the License, or
# (at your option) any later version.
# 
# This program 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 this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 

# Please email any bugs, comments, and/or additions to this file to:
# bug-dejagnu@prep.ai.mit.edu

# This file was written by Rob Savoye. (rob@welcomehome.org)

#
# Most of the procedures found here mimic their unix counter-part. 
# This file is sourced by runtest.exp, so they are usable by any test case.
#

#
# Gets the directories in a directory
#     args: the first is the dir to look in, the next
#         is the pattern to match. It
#         defaults to *. Patterns are csh style
#   	  globbing rules
#     returns: a list of dirs or NULL
#
proc getdirs { args } {
    set path [lindex $args 0]
    if { [llength $args] > 1} {
	set pattern [lindex $args 1]
    } else {
	set pattern "*"
    }
    verbose "Looking in ${path} for directories that match \"${pattern}\"" 3
    catch "glob ${path}/${pattern}" tmp
    if { ${tmp} != "" } {
	foreach i ${tmp} {
	    if [file isdirectory $i] {
		switch -- "[file tail $i]" {
		    "testsuite" -
		    "config" -
		    "lib" -
		    "CVS" -
		    "RCS" -
		    "SCCS" {
			verbose "Ignoring directory [file tail $i]" 3
			continue
		    }
		    default {
			if [file readable $i] {
			    verbose "Found directory [file tail $i]" 3
			    lappend dirs $i
			}
		    }
		}
	    }
	}	
    } else {
	perror "$tmp"
	return ""
    }
    
    if ![info exists dirs] {
	return ""
    } else {
	return $dirs
    }
}

#
# Finds all the files recursively
#     rootdir - this is the directory to start the search
#   	  from. This is and all subdirectories are search for
#   	  filenames. Directory names are not included in the
#   	  list, but the filenames have path information. 
#     pattern - this is the pattern to match. Patterns are csh style
#   	  globbing rules.
#     returns: a list or a NULL.
#
proc find { rootdir pattern } {
    # first find all the directories
    set dirs "$rootdir "
    while 1 {
	set tmp $rootdir
	set rootdir ""
	if [string match "" $tmp] {
	    break
	}
	foreach i $tmp {
	    set j [getdirs $i]
	    if ![string match "" $j] {
		append dirs "$j "
		set rootdir $j
		unset j
	    } else {
		set rootdir ""
	    }
	}
	set tmp ""
    }
    
    # find all the files that match the pattern
    foreach i $dirs {
	verbose "Looking in $i" 3
	set tmp [glob -nocomplain $i/$pattern]
	if { [llength $tmp] != 0 } {
	    foreach j $tmp {
		if ![file isdirectory $j] {
		    lappend files $j
		    verbose "Adding $j to file list" 3
		}
	    }
	}
    }
    
    if ![info exists files] {
	lappend files ""
    }
    return $files
}

#
# Search the path for a file. This is basically a version
# of the BSD-unix which utility. This procedure depends on
# the shell environment variable $PATH. It returns 0 if $PATH
# does not exist or the binary is not in the path. If the
# binary is in the path, it returns the full path to the binary.
#
proc which { file } {
    global env
    
    # strip off any extraneous arguments (like flags to the compiler)
    set file [lindex $file 0]
    
    # if it exists then the path must be OK
    # ??? What if $file has no path and "." isn't in $PATH?
    if [file exists $file] {
	return $file
    }
    if [info exists env(PATH)] {
	set path [split $env(PATH) ":"]
    } else {
	return 0
    }
    
    foreach i $path {
	verbose "Checking against $i" 3
	if [file exists $i/$file] {
	    if [file executable $i/$file] {
		return $i/$file
	    } else {
		warning "$i/$file exists but is not an executable"
	    }
	}
    }
    # not in path
    return 0
}

#
# Looks for a string in a file. 
#     return:list of lines that matched or NULL if none match.
#     args:  first arg is the filename,
#            second is the pattern,
#            third are any options.
#     Options: line  - puts line numbers of match in list
#
proc grep { args } {
    
    set file [lindex $args 0]
    set pattern [lindex $args 1]
    
    verbose "Grepping $file for the pattern \"$pattern\"" 3
    
    set argc [llength $args]
    if { $argc > 2 } {
	for { set i 2 } { $i < $argc } { incr i } {
	    append options [lindex $args $i]
	    append options " "
	}
    } else {
	set options ""
    }
    
    set i 0
    set fd [open $file r]
    while { [gets $fd cur_line]>=0 } {
	incr i
	if [regexp -- "$pattern" $cur_line match] {
	    if ![string match "" $options] {
		foreach opt $options {
		    case $opt in {
			"line" {
			    lappend grep_out [concat $i $match]
			}
		    }
		}
	    } else {
		lappend grep_out $match
	    }
	}
    }
    close $fd
    unset fd
    unset i
    if ![info exists grep_out] {
	set grep_out ""
    }
    return $grep_out
}

#
# Remove elements based on patterns. elements are delimited by spaces.
# pattern is the pattern to look for using glob style matching
# list is the list to check against
# returns the new list
#
proc prune { list pattern } {
    foreach i $list {
	verbose "Checking pattern \"$pattern\" against $i" 3
	if ![string match $pattern $i] {
	    lappend tmp $i
	} else {
	    verbose "Removing element $i from list" 3
	}
    }
    return $tmp
}

#
# Attempt to kill a process that you started
#
proc slay { name } {
    set in [open [concat "|ps"] r]
    while {[gets $in line]>-1} {
	if ![string match "*expect*slay*" $line] {
	    if [string match "*$name*" $line] {
		set pid [lindex $line 0]
		catch "exec kill -9 $pid]"
		verbose "Killing $name, pid = $pid\n"
	    }
	}
    }
    close $in
}

#
# Convert a relative path to an absolute one
#
proc absolute { path } {
    if [string match "." $path] {
        return [pwd]
    }
    
    set basedir [pwd]
    cd $path
    set path [pwd]
    cd $basedir
    return $path
}

#
# Source a file and trap any real errors. This ignores extraneous
# output. returns a 1 if there was an error, otherwise it returns 0.
#
proc psource { file } {
    global errorInfo
    global errorCode

    unset errorInfo
    if [file exists $file] {
	catch "source $file"
	if [info exists errorInfo] {
	    send_error "ERROR: errors in $file\n"
	    send_error "$errorInfo"
	    return 1
	}
    }
    return 0
}

#
# Check if a testcase should be run or not
#
# RUNTESTS is a copy of global `runtests'.
#
# This proc hides the details of global `runtests' from the test scripts, and
# implements uniform handling of "script arguments" where those arguments are
# file names (ie: the "foo" in make check RUNTESTFLAGS="bar.exp=foo").
# "glob" style expressions are supported as well as multiple files (with
# spaces between them).
# Eg: RUNTESTFLAGS="bar.exp=foo1.c foo2.c foo3*.c bar*.c"
#
proc runtest_file_p { runtests testcase } {
    if [string length [lindex $runtests 1]] {
	set testcase [file tail $testcase]
	foreach ptn [lindex $runtests 1] {
	    if [string match $ptn $testcase] {
		return 1
	    }
	}
	return 0
    }
    return 1
}

#
# Delete various system verbosities from TEXT on SYSTEM
#
# An example is:
# ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
#
# SYSTEM is typical $target_triplet or $host_triplet.
#
# This is useful when trying to do pattern matches on program output.
# Sites with particularily verbose os's may wish to override this in site.exp.
#
# We get loaded after site.exp so only define this if not already defined.
#

if { [info procs prune_system_crud] == "" } {
    proc prune_system_crud { system text } {
	# This is from sun4's.  Do it for all machines for now.
	# The "\\1" is to try to preserve a "\n" but only if necessary.
	regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text

	# This happens when compiling on Alpha OSF/1 with cc -g -O.
	regsub -all "(^|\n)(\n*uopt: Warning: file not optimized; use -g3 if both optimization and debug wanted\n?)+" $text "\\1" text

	# This happens when compiling on Alpha OSF using gas.
	regsub -all "(^|\n)(/usr/ucb/ld:\nWarning: Linking some objects which contain exception information sections\n\tand some which do not. This may cause fatal runtime exception handling\n\tproblems\[^\n\]*\n?)+" $text "\\1" text

	# This happens on SunOS with cc -g -O.
	regsub -all "(^|\n)(cc: Warning: -O conflicts with -g. -O turned off.\n?)+" $text "\\1" text

	# This happens when using g++ on a DWARF system.
	regsub -all "(^|\n)(cc1plus: warning: -g option not supported for C\\+\\+ on systems using the DWARF debugging format\n?)+" $text "\\1" text

	# It might be tempting to get carried away and delete blank lines, etc.
	# Just delete *exactly* what we're ask to, and that's it.
	return $text
    }
}

#
# Compares two files line-by-line
#     returns 1 it the files match,
#     returns 0 if there was a file error,
#     returns -1 if they didn't match.
#
proc diff { file_1 file_2 } {
    set eof -1
    set differences 0
    
    if [file exists ${file_1}] {
        set file_a [open ${file_1} r]
    } else {
        warning "${file_1} doesn't exist"
        return 0
    }
    
    if [file exists ${file_2}] {
        set file_b [open ${file_2} r]
    } else {
        warning "${file_2} doesn't exist"
        return 0
    }
    
    verbose "# Diff'ing: ${file_1} ${file_2}\n" 1
    
    while { [gets ${file_a} line] != ${eof} } {
        if [regexp "^#.*$" ${line}] {
            continue
        } else {
            lappend list_a ${line}
        }
    }
    close ${file_a}
    
    while { [gets ${file_b} line] != ${eof} } {
        if [regexp "^#.*$" ${line}] {
            continue
        } else {
            lappend list_b ${line}
        }
    }
    close ${file_b}
    for { set i 0 } { $i < [llength $list_a] } { incr i } {
        set line_a [lindex ${list_a} ${i}]
        set line_b [lindex ${list_b} ${i}]

#        verbose "\t${file_1}: ${i}: ${line_a}\n" 3
#        verbose "\t${file_2}: ${i}: ${line_b}\n" 3
        if [string compare ${line_a} ${line_b}] {
	    verbose "line #${i}\n" 2
            verbose "\< ${line_a}\n" 2
            verbose "\> ${line_b}\n" 2

	    send_log "line #${i}\n"
            send_log "\< ${line_a}\n"
            send_log "\> ${line_b}\n"

            set differences -1
        }
    }
    
    if { [llength ${list_a}] != [llength ${list_b}] } {
	verbose "Files not the same" 2
        set differences -1
    } else {
	verbose "Files are the same" 2
	set differences 1
    }
    return ${differences}
}

#
# Set an environment variable
#
proc setenv { var val } {
    global env
    
    set env($var) $val
}

#
# Unset an environment variable
#
proc unsetenv { var } {
    global env
    unset env($var)
}

#
# Get a value from an environment variable
#
proc getenv { var } {
    global env

    if [info exists env($var)] {
	return $env($var)
    } else {
	return ""
    }
}