Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 1 | proc execOneLine { test outcome lineno line } { |
| 2 | set status 0 |
| 3 | set resultmsg "" |
| 4 | set retval [ catch { eval exec -keepnewline -- $line } errmsg ] |
| 5 | if { $retval != 0 } { |
| 6 | set code [lindex $::errorCode 0] |
Reid Spencer | 520b487 | 2007-04-14 16:41:39 +0000 | [diff] [blame] | 7 | set lineno [expr $lineno + 1] |
Reid Spencer | 9a03bda | 2007-04-14 18:51:19 +0000 | [diff] [blame^] | 8 | set errmsg " at RUN: line $lineno\n$::errorInfo" |
Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 9 | switch "$code" { |
| 10 | CHILDSTATUS { |
| 11 | set status [lindex $::errorCode 2] |
| 12 | if { $status ne 0 } { |
Reid Spencer | 520b487 | 2007-04-14 16:41:39 +0000 | [diff] [blame] | 13 | set resultmsg "$test: exit($status)$errmsg" |
Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 14 | } |
| 15 | } |
| 16 | CHILDKILLED { |
| 17 | set signal [lindex $::errorCode 2] |
Reid Spencer | 520b487 | 2007-04-14 16:41:39 +0000 | [diff] [blame] | 18 | set resultmsg "$test: signal($signal)$errmsg" |
Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 19 | } |
| 20 | CHILDSUSP { |
| 21 | set signal [lindex $::errorCode 2] |
Reid Spencer | 520b487 | 2007-04-14 16:41:39 +0000 | [diff] [blame] | 22 | set resultmsg "$test: suspend($signal)$errmsg" |
Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 23 | } |
| 24 | POSIX { |
| 25 | set posixNum [lindex $::errorCode 1] |
| 26 | set posixMsg [lindex $::errorCode 2] |
Reid Spencer | 520b487 | 2007-04-14 16:41:39 +0000 | [diff] [blame] | 27 | set resultmsg "$test: posix($posixNum,$posixMsg)$errmsg" |
Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 28 | } |
| 29 | NONE { |
| 30 | } |
| 31 | default { |
| 32 | } |
| 33 | } |
| 34 | } |
| 35 | return $resultmsg |
| 36 | } |
| 37 | |
| 38 | proc substitute { line test tmpFile } { |
| 39 | global srcroot objroot srcdir objdir subdir target_triplet prcontext |
| 40 | global llvmgcc llvmgxx global llvmgcc_version llvmgccmajvers |
| 41 | global gccpath gxxpath compile_c compile_cxx link shlibext llvmlibsdir |
| 42 | |
| 43 | set new_line $line |
| 44 | #replace %prcontext with prcontext.tcl (Must replace before %p) |
| 45 | regsub -all {%prcontext} $new_line $prcontext new_line |
| 46 | #replace %llvmgcc with actual path to llvmgcc |
| 47 | regsub -all {%llvmgcc} $new_line "$llvmgcc -emit-llvm" new_line |
| 48 | #replace %llvmgxx with actual path to llvmg++ |
| 49 | regsub -all {%llvmgxx} $new_line "$llvmgxx -emit-llvm" new_line |
| 50 | #replace %compile_c with C compilation command |
| 51 | regsub -all {%compile_c} $new_line "$compile_c" new_line |
| 52 | #replace %compile_cxx with C++ compilation command |
| 53 | regsub -all {%compile_cxx} $new_line "$compile_cxx" new_line |
| 54 | #replace %link with C++ link command |
| 55 | regsub -all {%link} $new_line "$link" new_line |
| 56 | #replace %shlibext with shared library extension |
| 57 | regsub -all {%shlibext} $new_line "$shlibext" new_line |
| 58 | #replace %llvmlibsdir with configure library directory |
| 59 | regsub -all {%llvmlibsdir} $new_line "$llvmlibsdir" new_line |
| 60 | #replace %p with path to source, |
| 61 | regsub -all {%p} $new_line [file join $srcdir $subdir] new_line |
| 62 | #replace %s with filename |
| 63 | regsub -all {%s} $new_line $test new_line |
| 64 | #replace %t with temp filenames |
| 65 | regsub -all {%t} $new_line [file join Output $tmpFile] new_line |
| 66 | return $new_line |
| 67 | } |
| 68 | |
| 69 | proc llvm-runtest { programs } { |
| 70 | global srcroot objroot srcdir objdir subdir target_triplet |
| 71 | set timeout 60 |
| 72 | |
| 73 | set path [file join $objdir $subdir] |
| 74 | |
| 75 | #Make Output Directory if it does not exist already |
| 76 | if { [file exists path] } { |
| 77 | cd $path |
| 78 | } else { |
| 79 | file mkdir $path |
| 80 | cd $path |
| 81 | } |
| 82 | |
| 83 | file mkdir Output |
| 84 | |
| 85 | foreach test $programs { |
| 86 | #Should figure out best way to set the timeout |
| 87 | #set timeout 40 |
| 88 | |
| 89 | set filename [file tail $test] |
| 90 | set outcome PASS |
| 91 | set tmpFile "$filename.tmp" |
| 92 | |
| 93 | #set hasRunline bool to check if testcase has a runline |
| 94 | set numLines 0 |
| 95 | |
| 96 | # Open the test file and start reading lines |
| 97 | set testFileId [ open $test r] |
| 98 | set runline "" |
| 99 | foreach line [split [read $testFileId] \n] { |
| 100 | |
| 101 | #see if this is our run line |
| 102 | if {[regexp {END.[ *]$} $line match endofscript]} { |
| 103 | break |
Reid Spencer | 9a03bda | 2007-04-14 18:51:19 +0000 | [diff] [blame^] | 104 | } elseif {[regexp {RUN: *([^\\]+)(\\)$} $line match oneline suffix]} { |
Reid Spencer | 316abe4 | 2007-04-14 09:39:28 +0000 | [diff] [blame] | 105 | set runline "$runline$oneline " |
| 106 | } elseif {[regexp {RUN: *([^&]+)(&&)?} $line match oneline suffix]} { |
| 107 | set runline "$runline$oneline" |
| 108 | set runline [ substitute $runline $test $tmpFile ] |
| 109 | set lines($numLines) $runline |
| 110 | set numLines [expr $numLines + 1] |
| 111 | set runline "" |
| 112 | } elseif {[regexp {XFAIL:[ *](.+)} $line match targets]} { |
| 113 | set targets |
| 114 | |
| 115 | #split up target if more then 1 specified |
| 116 | foreach target [split $targets ,] { |
| 117 | if { [regexp {\*} $target match] } { |
| 118 | set outcome XFAIL |
| 119 | } elseif { [regexp $target $target_triplet match] } { |
| 120 | set outcome XFAIL |
| 121 | } elseif { [regexp {llvmgcc(([0-9]+)|([0-9]+[.][0-9]+))} $target match submatch submatch2] } { |
| 122 | if { [regexp ^($submatch)$|^(($submatch)(\.)) $llvmgcc_version match] } { |
| 123 | set outcome XFAIL |
| 124 | } |
| 125 | } |
| 126 | } |
| 127 | } |
| 128 | } |
| 129 | |
| 130 | # Done reading the script |
| 131 | close $testFileId |
| 132 | |
| 133 | |
| 134 | if { $numLines == 0 } { |
| 135 | fail "$test: \nDoes not have a RUN line\n" |
| 136 | } else { |
| 137 | set failed 0 |
| 138 | for { set i 0 } { $i < $numLines } { set i [ expr $i + 1 ] } { |
| 139 | regsub ^.*RUN:(.*) $lines($i) \1 theLine |
| 140 | set theLine [subst $theLine ] |
| 141 | set resultmsg [execOneLine $test $outcome $i $theLine ] |
| 142 | if { $resultmsg != "" } { |
| 143 | if { $outcome == "XFAIL" } { |
| 144 | xfail "$resultmsg" |
| 145 | } else { |
| 146 | fail "$resultmsg" |
| 147 | } |
| 148 | set failed 1 |
| 149 | break |
| 150 | } |
| 151 | } |
| 152 | if { !$failed } { |
| 153 | if { $outcome == "XFAIL" } { |
| 154 | xpass "$test" |
| 155 | } else { |
| 156 | pass "$resultmsg" |
| 157 | } |
| 158 | } |
| 159 | } |
| 160 | } |
| 161 | } |