You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by da...@apache.org on 2001/10/27 15:15:13 UTC
cvs commit: tcl-rivet/src/buildscripts aardvark.tcl
davidw 01/10/27 06:15:13
Modified: src mod_rivet.c
src/buildscripts aardvark.tcl
Log:
Aardvark updates.
Revision Changes Path
1.4 +1 -5 tcl-rivet/src/mod_rivet.c
Index: mod_rivet.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/mod_rivet.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mod_rivet.c 2001/10/19 08:39:40 1.3
+++ mod_rivet.c 2001/10/27 13:15:13 1.4
@@ -57,7 +57,7 @@
* originally written at the National Center for Supercomputing Applications,
* University of Illinois, Urbana-Champaign. */
-/* $Id: mod_rivet.c,v 1.3 2001/10/19 08:39:40 davidw Exp $ */
+/* $Id: mod_rivet.c,v 1.4 2001/10/27 13:15:13 davidw Exp $ */
/* mod_rivet.c by David Welton <da...@apache.org> - originally mod_include. */
/* See http://tcl.apache.org/mod_rivet/credits.ttml for additional credits. */
@@ -642,10 +642,6 @@
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Error in Tcl_CreateInterp, aborting\n");
exit(1);
}
-#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
- Tcl_FindExecutable(""); /* Needed for locating init.tcl */
-#endif
-
if (Tcl_Init(interp) == TCL_ERROR)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, Tcl_GetStringResult(interp));
1.4 +129 -126 tcl-rivet/src/buildscripts/aardvark.tcl
Index: aardvark.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/src/buildscripts/aardvark.tcl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- aardvark.tcl 2001/09/23 13:39:56 1.3
+++ aardvark.tcl 2001/10/27 13:15:13 1.4
@@ -1,5 +1,5 @@
# aardvark make-like system
-# $Id: aardvark.tcl,v 1.3 2001/09/23 13:39:56 davidw Exp $
+# $Id: aardvark.tcl,v 1.4 2001/10/27 13:15:13 davidw Exp $
# Copyright (c) 2001 Apache Software Foundation. All Rights reserved.
@@ -8,6 +8,7 @@
package provide aardvark 0.1
package require struct
+
namespace eval aardvark {
# the graph 'object' we use throughout.
variable grph
@@ -17,151 +18,153 @@
variable buildinfo
variable dependencies
set vbose 0
-
- proc Verbose { } {
- variable vbose
- set vbose 1
- }
+ # create a graph to use.
+ set grph [ ::struct::graph ]
+}
+proc aardvark::Verbose { } {
+ variable vbose
+ set vbose 1
+}
- # creates one node, if it doesn't exist, and creates it's data
- proc createnode { name } {
- variable grph
- if { ! [ $grph node exists $name ] } {
- $grph node insert $name
- $grph node set $name -key buildinfo {cmd "" tclcommand ""}
- }
+# creates one node, if it doesn't exist, and creates it's data
+proc aardvark::createnode { name } {
+ variable grph
+ if { ! [ $grph node exists $name ] } {
+ $grph node insert $name
+ $grph node set $name -key buildinfo {cmd "" tclcommand ""}
}
+}
# the command that gets run when we walk the graph.
- proc runbuildcommand { direction graphname node } {
- variable grph
- set rebuild 0
- set mtime 0
- set deps [ $grph nodes -out $node ]
- array set buildinfo [ $grph node get $node -key buildinfo ]
-
- # check file time
- if { [ file exists $node ] } {
- set mtime [ file mtime $node ]
+proc aardvark::runbuildcommand { direction graphname node } {
+ variable grph
+ set rebuild 0
+ set mtime 0
+ set deps [ $grph nodes -out $node ]
+ array set buildinfo [ $grph node get $node -key buildinfo ]
+
+ # check file time
+ if { [ file exists $node ] } {
+ set mtime [ file mtime $node ]
+ }
+
+ # rebuild if dependencies are newer than file
+ if { [ llength $deps ] > 0 } {
+ foreach dep $deps {
+ if { [ file exists $dep ] } {
+ set depmtime [ file mtime $dep ]
+ } else {
+ set depmtime 0
+ }
+ if { $depmtime > $mtime } {
+ set rebuild 1
+ }
}
-
- # rebuild if dependencies are newer than file
- if { [ llength $deps ] > 0 } {
- foreach dep $deps {
- if { [ file exists $dep ] } {
- set depmtime [ file mtime $dep ]
- } else {
- set depmtime 0
+ } else {
+ set rebuild 1
+ }
+
+ if { $rebuild == 1} {
+ if { $buildinfo(cmd) != "" } {
+ foreach cmd $buildinfo(cmd) {
+ set result ""
+ puts -nonewline "$node :"
+ catch {
+ set cmd [uplevel #0 "subst {$cmd}" ]
+ puts ""
+ puts "\tCommand: $cmd"
+ } err
+ if { $err != "" } {
+ puts "Command was supposed to be: $cmd"
+ puts "This error occured: $err"
+ continue
}
- if { $depmtime > $mtime } {
- set rebuild 1
+ catch {
+ set result [ eval exec $cmd ]
+ } err
+ if { $err != "" } {
+ puts "\tError: $err"
+ if { [ info exists ::errorCode ] && $::errorCode != "NONE" } {
+ puts "\tFatal Error ($::errorCode)!"
+ exit 1
+ }
+ break
}
+
+ if { $result != "" } {
+ puts "\tResult: $result"
+ }
}
- } else {
- set rebuild 1
- }
-
- if { $rebuild == 1} {
- if { $buildinfo(cmd) != "" } {
- foreach cmd $buildinfo(cmd) {
- set result ""
+ }
+ if { $buildinfo(tclcommand) != "" } {
+ foreach tclcommand $buildinfo(tclcommand) {
+ catch {
puts -nonewline "$node :"
- catch {
- set cmd [uplevel #0 "subst {$cmd}" ]
- puts ""
- puts "\tCommand: $cmd"
- } err
- if { $err != "" } {
- puts "Command was supposed to be: $cmd"
- puts "This error occured: $err"
- continue
- }
- catch {
- set result [ eval exec $cmd ]
- } err
- if { [ info exists errorInfo ] } {
- puts "\tERROR: $errorInfo"
- break
- } elseif { $err != "" } {
- puts "\tError: $err"
- break
- }
- if { $result != "" } {
- puts "\tResult: $result"
- }
- }
- }
- if { $buildinfo(tclcommand) != "" } {
- foreach tclcommand $buildinfo(tclcommand) {
- catch {
- puts -nonewline "$node :"
- puts ""
- puts "\tTcl Command: $tclcommand"
- uplevel #0 $tclcommand
- } err
- if { $err != "" } {
- puts $err
- }
+ puts ""
+ puts "\tTcl Command: $tclcommand"
+ uplevel #0 $tclcommand
+ } err
+ if { $err != "" } {
+ puts $err
}
- puts ""
}
+ puts ""
}
}
+}
- # these form the 'syntax' of our mini build language
- proc command { buildcmd } {
- variable buildinfo
- lappend buildinfo(cmd) $buildcmd
- return ""
- }
-
- proc tclcommand { tclcommand } {
- variable buildinfo
- lappend buildinfo(tclcommand) $tclcommand
+# these form the 'syntax' of our mini build language
+proc aardvark::command { buildcmd } {
+ variable buildinfo
+ lappend buildinfo(cmd) $buildcmd
return ""
- }
+}
- proc depends { deps } {
- variable dependencies
- set dependencies $deps
- return ""
- }
+proc aardvark::tclcommand { tclcommand } {
+ variable buildinfo
+ lappend buildinfo(tclcommand) $tclcommand
+ return ""
+}
- proc AddNode { name rest } {
- variable grph
- variable dependencies
- variable buildinfo
- set dependencies {}
- array set buildinfo {cmd "" tclcommand ""}
- set self $name
- catch {
- uplevel #0 $rest
- } err
- if { $err != "" } {
- puts "Error: $err"
- }
- createnode $name
- $grph node set $name -key buildinfo [ array get buildinfo ]
- foreach dep $dependencies {
-# puts -nonewline "$dep/"
- createnode $dep
- $grph arc insert $name $dep
- }
- }
+proc aardvark::depends { deps } {
+ variable dependencies
+ set dependencies $deps
+ return ""
+}
- proc Run { } {
- global ::argv
- variable grph
- set start [ lindex $::argv 0 ]
- if { $start != "" } {
- $grph walk $start -order post -command runbuildcommand
- } else {
- $grph walk all -order post -command runbuildcommand
- }
+proc aardvark::AddNode { name rest } {
+ variable grph
+ variable dependencies
+ variable buildinfo
+ set dependencies {}
+ array set buildinfo {cmd "" tclcommand ""}
+ set self $name
+ catch {
+ uplevel #0 $rest
+ } err
+ if { $err != "" } {
+ puts "Error: $err"
+ }
+ createnode $name
+ $grph node set $name -key buildinfo [ array get buildinfo ]
+ foreach dep $dependencies {
+ # puts -nonewline "$dep/"
+ createnode $dep
+ $grph arc insert $name $dep
}
+}
- # create graph
- set grph [ ::struct::graph ]
+proc aardvark::Run { } {
+ global ::argv
+ variable grph
+ set start [ lindex $::argv 0 ]
+ if { $start != "" } {
+ $grph walk $start -order post -command runbuildcommand
+ } else {
+ $grph walk all -order post -command runbuildcommand
+ }
+}
+namespace eval aardvark {
namespace export AddNode Run Verbose command tclcommand depends
}