3 # Copyright
(C
) 2010 Free Software Foundation
, Inc.
5 # This
program is free software
; you can redistribute it and
/or modify
6 # it 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.
10 # This
program is distributed in the hope that it will be useful
,
11 # but WITHOUT
ANY WARRANTY
; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License
for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this
program; if not
, write to the Free Software
16 # Foundation
, Inc.
, 51 Franklin St
, Fifth Floor
, Boston
, MA
02110-1301 USA
19 if {![info exists argv0
]} {
20 send_error
"Must use a version of Expect greater than 5.0\n"
25 # Global variables used by all files.
27 set logname
"" ;# the users login name
28 set configopts
"" ;# options to pass to configure
29 set branch
"trunk" ;# the bzr branch to build
30 set revno
"" ;# the bzr revno to build
31 set make
"make" ;# make program, sometimes gmake
32 set makeopts
"-w" ;# options to pass to make
33 set uploadcmd
"dupload" ;# program to upload packages
34 set objdir
"/build/trunk" ;# the base build tree
35 set srcdir
"/build/src/trunk" ;# the base source tree
44 # These
describe the host and target environments.
46 set build_triplet
"" ;# type of architecture to run tests on
47 set build_os
"" ;# type of os the tests are running on
48 set build_vendor
"" ;# vendor name of the OS or workstation the test are running on
49 set build_cpu
"" ;# type of the cpu tests are running on
50 set host_triplet
"" ;# type of architecture to run tests on, sometimes remotely
51 set host_os
"" ;# type of os the tests are running on
52 set host_vendor
"" ;# vendor name of the OS or workstation the test are running on
53 set host_cpu
"" ;# type of the cpu tests are running on
54 set target_triplet
"" ;# type of architecture to run tests on, final remote
55 set target_os
"" ;# type of os the tests are running on
56 set target_vendor
"" ;# vendor name of the OS or workstation the test are running on
57 set target_cpu
"" ;# type of the cpu tests are running on
58 set target_alias
"" ;# standard abbreviation of target
59 set compiler_flags
"" ;# the flags used by the compiler
60 set only
"no" ;# only run one state at a time
63 #
trap some signals so we know whats happening. These definitions are only
64 # temporary until we read in the library stuff
66 trap { send_user
"\nterminated\n"; exit 1 } SIGTERM
67 trap { send_user
"\ninterrupted by user\n"; exit 1 } SIGINT
68 trap { send_user
"\nsigquit\n"; exit 1 } SIGQUIT
71 # some convenience abbreviations
73 if {![info exists hex
]} {
74 set hex
"0x\[0-9A-Fa-f\]+"
76 if {![info exists decimal
]} {
77 set decimal
"\[0-9\]+"
82 #
set the base
dir (current working directory
)
87 # verbose
[-n
] [-log] [--] message
[level
]
89 # Print MESSAGE
if the verbose level is
>= LEVEL.
90 # The default value of LEVEL is
1.
91 #
"-n" says to not print a trailing newline.
92 #
"-log" says to add the text to the log file even if it won't be printed.
93 # Note that the apparent behaviour of `send_user
' dictates that if the message
94 # is printed it is also added to the log file.
95 # Use "--" if MESSAGE begins with "-".
97 # This is defined here rather than in framework.exp so we can use it
98 # while still loading in the support files.
100 proc verbose { args } {
106 if { [string index [lindex $args 0] 0] == "-" } {
107 for { set i 0 } { $i < [llength $args] } { incr i } {
108 if { [lindex $args $i] == "--" } {
111 } elseif { [lindex $args $i] == "-n" } {
113 } elseif { [lindex $args $i] == "-log" } {
115 } elseif { [lindex $args $i] == "-x" } {
117 } elseif { [string index [lindex $args $i] 0] == "-" } {
118 clone_output "ERROR: verbose: illegal argument: [lindex $args $i]"
124 if { [llength $args] == $i } {
125 clone_output "ERROR: verbose: nothing to print"
131 if { [llength $args] > $i + 1 } {
132 set level [lindex $args [expr { $i + 1 }]]
134 set message [lindex $args $i]
136 if { $verbose >= $level } {
137 # There is no need for the "--" argument here, but play it safe.
138 # We assume send_user also sends the text to the log file (which
139 # appears to be the case though the docs aren't clear
on this
).
141 send_user
-- "$message\n"
143 send_user
-- "$message"
145 } elseif
{ $logfile
} {
147 send_log
"$message\n"
154 # load_file
[-1] [--] file1
[ file2 ...
]
156 # Utility to source a file. All are sourced in order unless the flag
"-1"
157 # is given in which case we stop after finding the first one.
158 # The result is
1 if a file was found
, 0 if not.
159 #
If a tcl error occurs
while sourcing a file
, we print an error message
162 # ??? Perhaps add an optional
argument of some descriptive
text to add to
163 # verbose and error messages
(eg
: -t
"library file" ?).
165 proc load_file
{ args } {
168 if { [lindex $
args $i
] == "-1" } {
172 if { [lindex $
args $i
] == "--" } {
177 foreach file
[lrange $
args $i end
] {
178 verbose
"Looking for $file" 2
179 # In Tcl7.5a2
, "file exists" can fail if the filename looks
180 # like ~
/FILE and the environment
variable HOME does not
182 if {! [catch
{file
exists $file
} result
] && $result
} {
184 verbose
"Found $file"
185 if { [catch
"uplevel #0 source $file"] == 1 } {
186 send_error
"ERROR: tcl error sourcing $file.\n"
188 if {[info exists errorInfo
]} {
189 send_error
"$errorInfo\n"
202 # search_and_load_file
-- search DIRLIST looking
for FILELIST.
203 # TYPE is used when displaying error and progress messages.
205 proc search_and_load_file
{ type filelist dirlist
} {
208 foreach
dir $dirlist
{
209 foreach initfile $filelist
{
210 verbose
"Looking for $type ${dir}/${initfile}" 2
211 if {[file
exists [file join $
{dir} $
{initfile
}]]} {
214 if { $
{type
} != "library file" } {
215 send_user
"Using ${dir}/${initfile} as ${type}.\n"
217 verbose
"Loading ${dir}/${initfile}"
219 if {[catch
"uplevel #0 source ${dir}/${initfile}" error] == 1} {
221 send_error
"ERROR: tcl error sourcing ${type} ${dir}/${initfile}.\n${error}\n"
222 if {[info exists errorInfo
]} {
223 send_error
"$errorInfo\n"
238 # Give a usage statement.
243 send_user
"USAGE: buildhost \[options...\]\n"
244 send_user
"\t (--st) (-state)\t\tset the state manually\n"
245 send_user
"\t (--on) (-only)\t\tonly run the one state\n"
246 send_user
"\tstates are: bzr autogen configure make dpkg upload test clean"
250 #
Parse the arguments the first time looking
for these. We will ultimately
251 #
parse them twice. Things are complicated because
:
252 #
- we want to
parse --verbose early
on
253 #
- we don
't want config files to override command line arguments
254 # (eg: $base_dir/$configfile vs --host/--target)
255 # - we need some command line arguments before we can process some config files
256 # (eg: --objdir before $objdir/$configfile, --host/--target before $DEJAGNU)
257 # The use of `arg_host_triplet' and `arg_target_triplet
' lets us avoid parsing
258 # the arguments three times.
261 set arg_host_triplet ""
262 set arg_target_triplet ""
263 set arg_build_triplet ""
264 set argc [ llength $argv ]
265 for { set i 0 } { $i < $argc } { incr i } {
266 set option [lindex $argv $i]
268 # make all options have two hyphens
269 switch -glob -- $option {
273 set option "-$option"
277 # split out the argument for options that take them
278 switch -glob -- $option {
280 regexp {^[^=]*=(.*)$} $option nil optarg
287 set optarg [lindex $argv $i]
291 switch -glob -- $option {
292 "--ob*" { # (--objdir) where the test case object code lives
297 "--sr*" { # (--srcdir) where the source code lives
302 "--st*" { # (--state) the initial state
307 "--on*" { # (--only) only run one state, then exit
313 "--verb*" { # (--verbose) verbose output
318 "[A-Z0-9_-.]*=*" { # process makefile style args like CC=gcc, etc...
319 if {[regexp "^(\[A-Z0-9_-\]+)=(.*)$" $option junk var val]} {
321 verbose "$var is now $val"
322 append makevars "set $var $val;" ;# FIXME: Used anywhere?
325 send_error "Illegal variable specification:\n"
326 send_error "$option\n"
334 verbose "Verbose level is $verbose"
337 # get the users login name
339 if {[string match "" $logname]} {
340 if {[info exists env(USER)]} {
341 set logname $env(USER)
343 if {[info exists env(LOGNAME)]} {
344 set logname $env(LOGNAME)
346 # try getting it with whoami
347 catch "set logname [exec whoami]" tmp
348 if {[string match "*couldn't find
*to
execute*" $tmp]} {
349 # try getting it with who am i
351 catch
"set logname [exec who am i]" tmp
352 if {[string match
"*Command not found*" $tmp]} {
353 send_user
"ERROR: couldn't get the users login name\n"
354 set logname
"Unknown"
356 set logname
[lindex
[split $logname
" !"] 1]
364 # lookfor_file
-- try to find a file by searching up multiple directory levels
366 proc lookfor_file
{ dir name } {
367 foreach x
".. ../.. ../../.. ../../../.." {
368 verbose
"$dir/$name" 2
369 if {[file
exists [file join $
dir $
name]]} {
370 return [file join $
dir $
name]
372 set dir [remote_file build dirname $
dir]
378 # load_lib
-- load a library by sourcing it
380 #
If there a multiple files with the same
name, stop after the first one found.
381 # The order is first look in the install
dir, then in a parallel
dir in the
382 # source tree
, (up one or two levels
), then in the current
dir.
384 proc load_lib
{ file
} {
385 global verbose libdir srcdir base_dir execpath tool
388 if {[info exists loaded_libs
($file
)]} {
392 set loaded_libs
($file
) ""
394 if { [search_and_load_file
"library file" $file [list ../lib $libdir $libdir/lib [file dirname [file dirname $srcdir]]/dejagnu/lib $srcdir/lib $execpath/lib . [file dirname [file dirname [file dirname $srcdir]]]/dejagnu/lib]] == 0 } {
395 send_error
"ERROR: Couldn't find library file $file.\n"
400 # local_hostname
- get the local hostname
401 proc get_local_hostname
{ } {
402 if {[catch
"info hostname" hb]} {
405 regsub
"\\..*$" $hb "" hb
407 verbose
"hostname=$hb" 3
411 verbose
"Login name on [get_local_hostname] is $logname"
414 #
parse out the config parts of the triplet
name
418 if { $build_cpu
== "" } {
419 regsub
-- "-.*-.*" ${build_triplet} "" build_cpu
421 if { $build_vendor
== "" } {
422 regsub
-- "^\[a-z0-9\]*-" ${build_triplet} "" build_vendor
423 regsub
-- "-.*" ${build_vendor} "" build_vendor
425 if { $build_os
== "" } {
426 regsub
-- ".*-.*-" ${build_triplet} "" build_os
430 if { $host_cpu
== "" } {
431 regsub
-- "-.*-.*" ${host_triplet} "" host_cpu
433 if { $host_vendor
== "" } {
434 regsub
-- "^\[a-z0-9\]*-" ${host_triplet} "" host_vendor
435 regsub
-- "-.*" ${host_vendor} "" host_vendor
437 if { $host_os
== "" } {
438 regsub
-- ".*-.*-" ${host_triplet} "" host_os
442 if { $target_cpu
== "" } {
443 regsub
-- "-.*-.*" ${target_triplet} "" target_cpu
445 if { $target_vendor
== "" } {
446 regsub
-- "^\[a-z0-9\]*-" ${target_triplet} "" target_vendor
447 regsub
-- "-.*" ${target_vendor} "" target_vendor
449 if { $target_os
== "" } {
450 regsub
-- ".*-.*-" ${target_triplet} "" target_os
454 #
Load some of the DejaGnu libraries
, so we can use the configure
455 # and build procedures ourselves. Most of the time
, these files
456 # live in
/usr or
/usr
/local.
458 if {[file
exists "/usr/share/dejagnu"]} {
459 set libdir
"/usr/share/dejagnu"
461 set libdir
"/usr/local/share/dejagnu"
463 set execpath
[file dirname $argv0
]
464 if {[info exists env
(DEJAGNULIBS
)]} {
465 set libdir $env
(DEJAGNULIBS
)
467 load_lib framework.exp
472 #
set an output file
name for commands
474 #
set outp
"> /tmp/foo"
477 set sum
[open $sumfile w
]
479 # print an entry to the summary file
480 proc sumfile
{ msg
} {
485 # print an informational entry to the summary file
486 proc suminfo
{ msg
} {
487 global inp outp timeout srcdir sum
488 set whoami
[exec whoami
]
490 #
set logname
[exec
'grep $whoami /etc/passwd | cut -d ":" -f 5']
491 set ret
[local_exec
"uname --kernel-name --kernel-release" $inp $outp $timeout]
492 set status [lindex $ret
0]
493 set output
[lindex $ret
1]
494 puts $sum
"$msg: $date"
495 set rpm_opts
[getenv RPM_BUILD_OPTIONS
]
496 if {[string length $rpm_opts
] > 0} {
497 puts $sum
"RPM_BUILD_OPTIONS: $rpm_opts"
499 set deb_opts
[getenv DEB_BUILD_OPTIONS
]
500 if {[string length $deb_opts
] > 0} {
501 puts $sum
"DEB_BUILD_OPTIONS: $deb_opts"
503 # puts $sum
"$whoami"
507 # print a Start entry to the summary file
508 proc procstart
{ msg
} {
510 puts $sum
"+ $msg: Started"
513 # print a Start entry to the summary file
514 proc procdone
{ msg
} {
516 puts $sum
"- $msg: Done"
519 #
update the source tree. This assume you already have it checked out.
520 proc changedir
{ dir } {
522 verbose
"Changed to directory: [pwd]"
525 #
update the source tree. This assumes you already have it checked out
526 # in the desired directory.
528 global inp outp timeout objdir srcdir
531 set ret
[local_exec
"bzr pull" $inp $outp $timeout]
532 set status [lindex $ret
0]
533 set output
[lindex $ret
1]
534 #
if we couldn
't update the sources, then we can't proceed
536 perror
"bzr pull failed! " $output
543 # extract the revision number
545 global inp outp timeout objdir
547 set ret
[local_exec
"grep REVNO revno.h" $inp $outp $timeout]
548 set status [lindex $ret
0]
549 set output
[lindex $ret
1]
553 regsub
".* = " $output "" revno
554 set revno
[string trim $revno
]
555 set revno
[string trim $revno
"\;\n\""]
557 #
if we couldn
't update the sources, then we can't proceed
559 perror
"bzr revno failed! " $output
564 # extract the branch nickname
566 global inp outp timeout verbose srcdir objdir
568 set ret
[local_exec
"grep NICK revno.h" $inp $outp $timeout]
570 set status [lindex $ret
0]
571 set output
[lindex $ret
1]
575 regsub
".* = " $output "" nick
576 set nick
[string trim $nick
]
577 set nick
[string trim $nick
"\;\n\""]
579 #
if we couldn
't update the sources, then we can't proceed
581 perror
"bzr branch failed! " $output
586 # run the Gnash autogen
,sh script to regenerate config files.
588 global inp outp timeout srcdir
589 # recreate the build files
592 set ret
[local_exec
"./autogen.sh" $inp $outp $timeout]
593 set status [lindex $ret
0]
594 set output
[lindex $ret
1]
595 #
if autogen.sh fails
, then we can
't proceed
597 perror "./autogen.sh failed! " $output
604 # configure a checked out tree
605 proc configure { opts } {
606 global inp outp timeout srcdir objdir
608 procstart "Configure"
610 # add any options to the sumfile
611 if {[string length $opts] > 0} {
612 sumfile "Configure options: $opts"
614 set ret [local_exec "$srcdir/configure $opts" $inp $outp $timeout]
615 set status [lindex $ret 0]
616 set output [lindex $ret 1]
617 # if configuring fails, then we can't proceed
619 perror
"$srcdir/configure failed with these options: $configopts! $output"
626 # build a Debian package
628 global inp outp timeout objdir package revno branch
630 # find the snapshot directory
631 foreach i
[glob
-nocomplain $objdir
/gnash
-*bzr
*] {
632 if {[file isdirectory $i
]} {
639 set ret
[local_exec
"dpkg-buildpackage $opts" $inp $outp $timeout]
640 set status [lindex $ret
0]
641 set output
[lindex $ret
1]
642 #
if configuring fails
, then we can
't proceed
644 perror "dpkg-buildpackage failed with these options: $opts! $output"
650 # run make to compile everything
652 global inp outp timeout make objdir
655 # add any options to the sumfile
656 if {[string length $opts] > 0} {
657 sumfile "Make flags: $opts"
659 set ret [local_exec "$make $opts" $inp $outp 1000]
660 set status [lindex $ret 0]
661 set output [lindex $ret 1]
662 # if configuring fails, then we can't proceed
664 perror
"$make failed with these options: $opts! $output"
671 # upload files to the repository
672 proc upload
{ files
} {
673 global inp outp timeout objdir uploadcmd
676 if {$uploadcmd
== "dupload"} {
677 set ret
[local_exec
"$uploadcmd $files" $inp $outp $timeout]
679 if {$uploadcmd
== "scp"} {
680 set ret
[local_exec
"$uploadcmd $files" $inp $outp $timeout]
682 set status [lindex $ret
0]
683 set output
[lindex $ret
1]
684 #
if configuring fails
, then we can
't proceed
686 perror "$uploadcmd failed to upload $changes!: $output"
694 # remove old package builds
696 set ret [local_exec "rm -fr gnash-*" $inp $outp $timeout]
697 set status [lindex $ret 0]
698 set output [lindex $ret 1]
699 # if configuring fails, then we can't proceed
701 perror
"$uploadcmd failed to upload $changes!: $output"
707 # see
if this is a apt or rpm based
system
708 # All Debian based systems have this file
, which no rpm based ones
do
709 if {[file
exists /etc
/network
/interfaces
]} {
715 verbose
"Building a $package package"
717 # The real guts start here
720 #
set a default timeoput value
for comamnd exececution. Some commands
,
721 # like bzr checkouts can
725 #
Switch to the source directory now
729 # extract
info so we know what we
're building
730 set revno [bzr_revno]
731 set branch [bzr_branch]
736 # the state table is the sequence of tasks required to build Gnash.
737 while {$state != "done"} {
738 verbose "======= Current state is: $state ======="
739 switch -glob -- $state {
742 verbose "Changed to source tree: $srcdir"
743 set output [bzr_update]; # update the source tree
744 # update the branch and revision after the update
745 set revno [bzr_revno]
746 set branch [bzr_branch]
747 # if {[string match "*configure.ac*" $output]} {
748 set state "autogen.sh"
750 # set state "configure"
754 "a*" { # "autogen.sh"
756 autogen; # create the config and build files
757 set state "configure"
760 "co*" { # "configure"
761 # Switch to the build directory now
763 verbose "Changed to build tree: $objdir"
764 configure "$configopts"
774 "dp*" { # "dpkg-buildpackage"
775 # This should only be run by package code maintainers, as this
776 # manually runs dpkg-buildpackage, and assumes everything is
777 # all setup correctly, or it'll fail. This is basically just
778 # an optimization step when debugging package building.
793 # test the repository to make sure it worked
799 #
Switch to the build directory now
801 verbose
"Changed to build tree: $objdir"
806 # exit the
while loop
if we only want to run one step of the state table
807 if { $only
== "yes" } {
813 #
back to where we started