@ -1,43 +1,173 @@
# t e s t _ g a t e . t c l ( G - 1 0 2 ) : r u n t h e T c l c o r e t e s t s u i t e u n d e r T H I S i n t e r p r e t e r ' s o w n
# s h e l l ( [ i n f o n a m e o f e x e c u t a b l e ] - t h e s u i t e - b u i l t t c l s h w h e n d r i v e n a s t h e
# ' z i g b u i l d t e s t - g a t e ' s t e p ) a n d G A T E o n t h e p a r s e d t o t a l s : a l l . t c l ' s e x i t c o d e
# d o e s N O T r e f l e c t f a i l u r e s , s o e v e r y f a i l e d t e s t m u s t a p p e a r i n t h e t r a c k e d
# d i s p o s i t i o n e d b a s e l i n e o r t h e g a t e f a i l s l i s t i n g t h e u n e x p l a i n e d n a m e s .
# F o r m e r l y s u i t e . t c l ' s ' t e s t ' a c t i o n ; s u i t e . t c l n o w d e l e g a t e s h e r e .
# t e s t _ g a t e . t c l ( G - 1 0 2 c o r e g a t e ; g e n e r a l i z e d f o r t h e G - 1 0 7 l i b r a r y t e s t r u n s ) :
# r u n a t c l t e s t - d r i v e n t e s t s u i t e u n d e r T H I S i n t e r p r e t e r ' s o w n s h e l l
# ( [ i n f o n a m e o f e x e c u t a b l e ] - t h e s u i t e - b u i l t t c l s h w h e n d r i v e n a s a
# ' z i g b u i l d t e s t - * ' s t e p ) a n d a c t o n t h e P A R S E D t o t a l s : t c l t e s t d r i v e r s ' e x i t
# c o d e s d o N O T r e f l e c t f a i l u r e s , s o r e s u l t s a r e j u d g e d f r o m t h e c a p t u r e d l o g .
#
# a r g s : - t e s t s d i r < d i r > - b a s e l i n e < f i l e > - l o g f i l e < f i l e > ? - t e s t a r g s { t c l t e s t a r g s } ?
# M o d e s ( - m o d e , d e f a u l t g a t e ) :
# g a t e e v e r y f a i l e d t e s t m u s t a p p e a r i n t h e t r a c k e d d i s p o s i t i o n e d b a s e l i n e
# o r t h e g a t e f a i l s l i s t i n g t h e u n e x p l a i n e d n a m e s ( t h e c o r e t e s t - g a t e
# m e c h a n i s m , G - 0 9 8 ) ; n o t e s b a s e l i n e e n t r i e s t h a t n o l o n g e r f a i l .
# r e c o r d t h e r u n m u s t C O M P L E T E ( t o t a l s p a r s e d ) b u t f a i l u r e s d o n o t f a i l t h e
# s t e p - r e s u l t s a r e r e c o r d e d a s e v i d e n c e ( G - 1 0 7 l i b r a r y p o l i c y t i e r
# f o r s u i t e s w i t h o u t a d i s p o s i t i o n e d b a s e l i n e y e t ) .
# E V E R Y m o d e : a r u n w i t h n o p a r s e a b l e a g g r e g a t e t o t a l s l i n e F A I L S t h e s t e p -
# i n f r a s t r u c t u r e b r e a k a g e m u s t n e v e r m a s q u e r a d e a s r e c o r d e d r e s u l t s .
#
# D r i v e r : < t e s t s d i r > / a l l . t c l b y d e f a u l t . t c l l i b - f a m i l y t r e e s a r e d r i v e n v i a
# t h e i r o w n s u p p o r t / d e v e l / a l l . t c l ( - d r i v e r ) , w h i c h r u n s e v e r y m o d u l e ' s t e s t
# f i l e s i n p e r - f i l e c h i l d i n t e r p s a n d a g g r e g a t e s c o u n t s i n t o t h e s a m e s t a n d a r d
# t o t a l s l i n e ( ' a l l . t c l : T o t a l N P a s s e d N S k i p p e d N F a i l e d N ' ) . T h a t d r i v e r
# m a r k s a t e s t f i l e t h a t e r r o r s o u t w i t h ' @ + ' / ' @ | ' e r r o r I n f o b l o c k s - c o u n t e d
# h e r e a s e r r o r e d _ f i l e s e v i d e n c e ( r e c o r d e d i n t h e s u m m a r y , n o t a g a t e c r i t e r i o n ;
# t h e g a t e c r i t e r i o n s t a y s t o t a l s - v s - b a s e l i n e , c o r e - g a t e s e m a n t i c s ) . T h e
# r u n A l l T e s t s - v i n t a g e d r i v e r s ( t c l c o r e , t k ) r e p o r t ' T e s t f i l e s e x i t i n g w i t h
# e r r o r s : ' - c a p t u r e d a s e r r o r e x i t _ f i l e s e v i d e n c e t h e s a m e w a y .
#
# E v i d e n c e s u m m a r y ( - s u m m a r y f i l e ) : a l i n e - r e c o r d f i l e f o r a r t i f a c t - m e t a d a t a
# c o n s u m e r s ( G - 1 0 3 ) . E a c h n o n - c o m m e n t l i n e i s a T c l l i s t : ' < k e y > < v a l u e > '
# ( v a l u e m a y i t s e l f b e a l i s t ) . S h a p e d o c u m e n t e d i n
# g o a l s / G - 1 0 7 - b u i l d s u i t e - l i b r a r y - t e s t s . m d .
#
# a r g s : - t e s t s d i r < d i r > - l o g f i l e < f i l e > ? - m o d e g a t e | r e c o r d ?
# ? - b a s e l i n e < f i l e > ? ( r e q u i r e d i n g a t e m o d e )
# ? - d r i v e r < f i l e > ? ( d e f a u l t a l l . t c l ; r e l a t i v e p a t h s r e s o l v e a g a i n s t - t e s t s d i r )
# ? - s u m m a r y f i l e < f i l e > ? ? - l i b r a r y < n a m e > ? ? - t e s t a r g s { t c l t e s t a r g s } ?
proc fail { msg } { puts stderr " t e s t _ g a t e E R R O R : $ m s g " ; flush stderr; exit 1 }
array set opt { -testsdir { } - baseline { } - logfile { } - testargs { } }
array set opt { -testsdir { } - baseline { } - logfile { } - testargs { } - mode gate - driver all.tcl - summaryfile { } - library { } }
foreach { k v} $argv {
if { ! [ info exists opt( $k ) ] } { fail " u n k n o w n o p t i o n ' $ k ' ( e x p e c t e d - t e s t s d i r - b a s e l i n e - l o g f i l e - t e s t a r g s ) " }
if { ! [ info exists opt( $k ) ] } { fail " u n k n o w n o p t i o n ' $ k ' ( e x p e c t e d - t e s t s d i r - b a s e l i n e - l o g f i l e - m o d e - d r i v e r - s u m m a r y f i l e - l i b r a r y - e s t a r g s ) " }
set opt( $k ) $v
}
foreach req { -testsdir - baseline - logfile} {
foreach req { -testsdir - logfile} {
if { $opt ( $req ) eq " " } { fail " m i s s i n g r e q u i r e d o p t i o n $ r e q " }
}
if { $opt ( -mode ) ni { gate record} } { fail " u n k n o w n - m o d e ' $ o p t ( - m o d e ) ' ( e x p e c t e d g a t e | r e c o r d ) " }
if { ! [ file isdirectory $opt ( -testsdir ) ] } { fail " n o t e s t s d i r a t $ o p t ( - t e s t s d i r ) - b u i l d f i r s t " }
if { ! [ file exists $opt ( -baseline ) ] } { fail " n o b a s e l i n e f i l e a t $ o p t ( - b a s e l i n e ) " }
if { $opt ( -mode ) eq " g a t e " } {
if { $opt ( -baseline ) eq " " } { fail " - m o d e g a t e r e q u i r e s - b a s e l i n e " }
if { ! [ file exists $opt ( -baseline ) ] } { fail " n o b a s e l i n e f i l e a t $ o p t ( - b a s e l i n e ) - f o r a f i r s t c e n s u s r u n t h e s t e p i n r e c o r d m o d e ( - D t e s t p o l i c y - < l i b > = r e c o r d ) , d i s p o s i t i o n t h e r e c o r d e d f a i l u r e s i n t o t h e b a s e l i n e , t h e n g a t e " }
}
set library $opt ( -library )
if { $library eq " " } { set library [ file tail [ file normalize $opt ( -testsdir ) ] ] }
set exe [ info nameofexecutable]
set logfile [ file normalize $opt ( -logfile ) ]
puts " t e s t _ g a t e : t c l t e s t s u i t e u n d e r $ e x e [ e x p r { [ l l e n g t h $ o p t ( - t e s t a r g s ) ] ? $ o p t ( - t e s t a r g s ) : " ( f u l l s u i t e ) " } ] - > $ l o g f i l e "
file mkdir [ file dirname $logfile ]
set driver $opt ( -driver )
if { [ file pathtype $driver ] ne " a b s o l u t e " } { set driver [ file join $opt ( -testsdir ) $driver ] }
set driver [ file normalize $driver ]
if { ! [ file exists $driver ] } { fail " n o d r i v e r s c r i p t a t $ d r i v e r " }
# - - e v i d e n c e s u m m a r y ( w r i t t e n o n e v e r y o u t c o m e o n c e t h e r u n h a s b e e n a t t e m p t e d )
set summary [ dict create]
proc sumset { key value} { global summary; dict set summary $key $value }
proc write_summary { } {
global opt summary
if { $opt ( -summaryfile ) eq " " } return
set sf [ file normalize $opt ( -summaryfile ) ]
file mkdir [ file dirname $sf ]
set f [ open $sf w]
fconfigure $f - translation lf
puts $f " # l i b r a r y - t e s t e v i d e n c e s u m m a r y ( G - 1 0 7 ; c o n s u m e d b y G - 1 0 3 a r t i f a c t m e t a d a t a ) "
puts $f " # l i n e r e c o r d s : < k e y > < v a l u e > - p a r s e e a c h n o n - c o m m e n t l i n e a s a T c l l i s t . "
puts $f " # s h a p e : g o a l s / G - 1 0 7 - b u i l d s u i t e - l i b r a r y - t e s t s . m d ( p u n k s h e l l r e p o ) "
dict for { k v} $summary { puts $f [ list $k $v ] }
close $f
}
proc finish { result failreason msg} {
# s i n g l e e x i t p o i n t a f t e r t h e r u n : r e c o r d o u t c o m e , w r i t e s u m m a r y , r e p o r t
global opt logfile
sumset result $result
if { $failreason ne " " } { sumset failreason $failreason }
write_summary
if { $opt ( -summaryfile ) ne " " } {
puts " t e s t _ g a t e : e v i d e n c e : [ f i l e n o r m a l i z e $ o p t ( - s u m m a r y f i l e ) ] ( l o g : $ l o g f i l e ) "
}
if { $result eq " p a s s " } {
puts " t e s t _ g a t e : $ m s g "
exit 0
}
puts stderr " t e s t _ g a t e $ m s g "
flush stderr
exit 1
}
sumset library $library
sumset mode $opt ( -mode )
sumset shell $exe
sumset driver $driver
sumset testsdir [ file normalize $opt ( -testsdir ) ]
sumset testargs $opt ( -testargs )
sumset baseline [ expr { $opt ( -baseline ) ne " " ? [ file normalize $opt ( -baseline ) ] : " " } ]
sumset logfile $logfile
puts " t e s t _ g a t e : $ l i b r a r y t e s t s u i t e u n d e r $ e x e [ e x p r { [ l l e n g t h $ o p t ( - t e s t a r g s ) ] ? $ o p t ( - t e s t a r g s ) : " ( f u l l s u i t e ) " } ] ( m o d e $ o p t ( - m o d e ) ) - > $ l o g f i l e "
flush stdout
set savedpwd [ pwd ]
cd $opt ( -testsdir )
catch { exec $exe all.tcl { * } $opt ( -testargs ) > $logfile 2 > @ 1 }
catch { exec $exe $driver { * } $opt ( -testargs ) > $logfile 2 > @ 1 }
cd $savedpwd
set f [ open $logfile r] ; set testout [ read $f ] ; close $f
if { ! [ regexp { all \ .tcl:\ s+ Total\ s+ ( \ d + ) \ s+ Passed\ s+ ( \ d + ) \ s+ Skipped\ s+ ( \ d + ) \ s+ Failed\ s+ ( \ d + ) } $testout - > ntotal npassed nskipped nfailed] } {
fail " n o a l l . t c l t o t a l s l i n e f o u n d i n $ l o g f i l e - r u n d i d n o t c o m p l e t e "
# a g g r e g a t e t o t a l s : t h e m a s t e r d r i v e r ' s f i n a l c l e a n u p T e s t s / r u n A l l T e s t s l i n e .
# T a k e t h e L A S T m a t c h - p e r - f i l e s u m m a r y l i n e s c a r r y t h e f i l e ' s o w n n a m e , b u t a
# d r i v e r a r r a n g e m e n t t h a t r e u s e s ' a l l . t c l ' f o r a n e s t e d s t a g e m u s t n o t s h a d o w
# t h e f i n a l a g g r e g a t e .
set quads [ regexp - all - inline { all \ .tcl:\ s+ Total\ s+ ( \ d + ) \ s+ Passed\ s+ ( \ d + ) \ s+ Skipped\ s+ ( \ d + ) \ s+ Failed\ s+ ( \ d + ) } $testout ]
if { ! [ llength $quads ] } {
finish fail no-totals " F A I L ( $ l i b r a r y ) : n o a l l . t c l t o t a l s l i n e f o u n d i n $ l o g f i l e - r u n d i d n o t c o m p l e t e "
}
lassign [ lrange $quads end-3 end] ntotal npassed nskipped nfailed
puts " t e s t _ g a t e : t o t a l s : $ n t o t a l r u n , $ n p a s s e d p a s s e d , $ n s k i p p e d s k i p p e d , $ n f a i l e d f a i l e d "
sumset total $ntotal
sumset passed $npassed
sumset skipped $nskipped
sumset failed $nfailed
set failednames { }
foreach { - tname} [ regexp - all - inline - line { ^ == == ( \ S + ) FAILED } $testout ] {
if { $tname ni $failednames } { lappend failednames $tname }
}
sumset failednames $failednames
# f i l e - l e v e l c o m p l e t e n e s s e v i d e n c e ( r e c o r d e d , n o t g a t e c r i t e r i a - t h e g a t e
# c r i t e r i o n i s t o t a l s - v s - b a s e l i n e , m a t c h i n g t h e c o r e g a t e ) :
# t c l l i b - f a m i l y d r i v e r : a t e s t f i l e t h a t e r r o r s m i d - s o u r c e i s c a u g h t a n d m a r k e d
# w i t h a n ' @ + ' l i n e f o l l o w e d b y ' @ | ' e r r o r I n f o l i n e s .
set errored_count 0
foreach line [ split $testout \ n] {
if { $line eq " @ + " } { incr errored_count}
}
sumset errored_files $errored_count
# r u n A l l T e s t s - v i n t a g e d r i v e r s ( t c l c o r e , t k ) : ' T e s t f i l e s e x i t i n g w i t h e r r o r s : '
# s e c t i o n l i s t s f i l e s w h o s e c h i l d r u n e r r o r e d .
set errorexit_files { }
if { [ regexp - indices { Test files exiting with errors:} $testout headidx] } {
set tailtext [ string range $testout [ lindex $headidx 1 ] + 1 end]
foreach line [ split $tailtext \ n] {
set line [ string trim $line ]
if { $line eq " " } continue
if { [ regexp { ^ ( \ S + \ .test) $ } $line - > fname] } {
lappend errorexit_files $fname
} else {
break
}
}
}
sumset errorexit_files $errorexit_files
if { $errored_count || [ llength $errorexit_files ] } {
puts " t e s t _ g a t e : n o t e : f i l e - l e v e l e r r o r s r e c o r d e d : e r r o r e d _ f i l e s = $ e r r o r e d _ c o u n t e r r o r e x i t _ f i l e s = [ l l e n g t h $ e r r o r e x i t _ f i l e s ] ( [ j o i n $ e r r o r e x i t _ f i l e s { } ] ) "
}
if { $opt ( -mode ) eq " r e c o r d " } {
finish pass " " " R E C O R D E D ( $ l i b r a r y ) : $ n t o t a l r u n , $ n f a i l e d f a i l e d ( [ l l e n g t h $ f a i l e d n a m e s ] d i s t i n c t n a m e s ) - e v i d e n c e a r t i f a c t s w r i t t e n "
}
# - - g a t e m o d e : d i f f f a i l e d n a m e s a g a i n s t t h e d i s p o s i t i o n e d b a s e l i n e
# b a s e l i n e : o n e t e s t n a m e p e r l i n e ; ' # ' c o m m e n t s c a r r y t h e d i s p o s i t i o n r e a s o n s
set baseline { }
set f [ open $opt ( -baseline ) r]
@ -51,9 +181,10 @@ set unexplained {}
foreach tname $failednames {
if { $tname ni $baseline } { lappend unexplained $tname }
}
sumset unexplained $unexplained
set stale { }
if { ! [ llength $opt ( -testargs ) ] } {
# o n l y m e a n i n g f u l f o r f u l l r u n s : b a s e l i n e e n t r i e s t h a t n o l o n g e r f a i l
set stale { }
foreach tname $baseline {
if { $tname ni $failednames } { lappend stale $tname }
}
@ -61,11 +192,12 @@ if {![llength $opt(-testargs)]} {
puts " t e s t _ g a t e : n o t e : [ l l e n g t h $ s t a l e ] b a s e l i n e e n t r i e s d i d n o t f a i l t h i s r u n ( c a n d i d a t e s f o r r e m o v a l ) : $ s t a l e "
}
}
sumset stalebaseline $stale
if { [ llength $unexplained ] } {
puts stderr " t e s t _ g a t e G A T E F A I L : [ l l e n g t h $ u n e x p l a i n e d ] f a i l e d t e s t ( s ) n o t i n t h e e x p e c t e d - f a i l u r e b a s e l i n e : "
puts stderr " t e s t _ g a t e G A T E F A I L ( $ l i b r a r y ) [ l l e n g t h $ u n e x p l a i n e d ] f a i l e d t e s t ( s ) n o t i n t h e e x p e c t e d - f a i l u r e b a s e l i n e : "
foreach tname $unexplained { puts stderr " $ t n a m e " }
puts stderr " ( f u l l o u t p u t : $ l o g f i l e ; b a s e l i n e : $ o p t ( - b a s e l i n e ) ) "
exit 1
flush stderr
finish fail unexplained " G A T E F A I L ( $ l i b r a r y ) : [ l l e n g t h $ u n e x p l a i n e d ] u n e x p l a i n e d f a i l u r e ( s ) - s e e a b o v e "
}
puts " t e s t _ g a t e : G A T E P A S S ( [ l l e n g t h $ f a i l e d n a m e s ] f a i l u r e s , a l l b a s e l i n e d ) "
exit 0
finish pass " " " G A T E P A S S ( $ l i b r a r y ) : [ l l e n g t h $ f a i l e d n a m e s ] f a i l u r e s , a l l b a s e l i n e d "
