Check-in [8efd9e603c]

Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Prevent installation abort when fossil executable is missing. Also made code more robust against an early fail leaving some variables undefined.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 8efd9e603c39f5d2c61ddc899c009957a04934cc
User & Date: andreask 2015-05-06 18:31:25
Original Comment: Prevent installation abort when fossil executable is missing. Also made code more robust against eraly fail leaving some variables undefined.
Context
2017-06-14
23:40
Bit of extended debugging in meta data handling. Fixed issue with name to use in the meta data of apps. check-in: 26eece52d6 user: aku tags: trunk
2015-05-06
18:31
Prevent installation abort when fossil executable is missing. Also made code more robust against an early fail leaving some variables undefined. check-in: 8efd9e603c user: andreask tags: trunk
2015-04-17
21:50
Goals added which show the content (packages, apps) found in the build. Packages are listed with version info. check-in: 940893cb88 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to meta.tcl.

225
226
227
228
229
230
231
232


233
234



235
236
237
238
239
240
241
    # But only if we are in a fossil checkout.

    # TODO: Handle git also

    if {![dict exists $m location] &&
	([path find.fossil [path sourcedir]] ne {})
    } {
	set remote [exec {*}[auto_execok fossil] remote]


	regsub {/[^@]*@} $remote {/} remote
	dict set m location $remote



    }
    return
}

# # ## ### ##### ######## ############# #####################
## Internals







|
>
>
|
|
>
>
>







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
    # But only if we are in a fossil checkout.

    # TODO: Handle git also

    if {![dict exists $m location] &&
	([path find.fossil [path sourcedir]] ne {})
    } {
	set fossilcmd [auto_execok fossil]
	if {[llength $fossilcmd]} {
	    set remote [exec {*}$fossilcmd remote]
	    regsub {/[^@]*@} $remote {/} remote
	    dict set m location $remote
	} else {
	    dict set m location Unknown
	}
    }
    return
}

# # ## ### ##### ######## ############# #####################
## Internals

Changes to path.tcl.

869
870
871
872
873
874
875


876
877
878
879



880
881
882
883
884
885
886
	    set v [lindex [split [dict get $o -errorinfo] \n] 0]
	}
    }
    return [string trim $v]
}

proc ::kettle::path::revision.fossil {path} {


    in $path {
	set info [::exec {*}[auto_execok fossil] info]
    }
    return [lindex [grep {checkout:*} $info] 0 1]



}

proc ::kettle::path::is.git {path} {
    set control $path/.git
    expr {[file exists $control] && [file isdirectory $control]}
}







>
>
|
|
|
|
>
>
>







869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
	    set v [lindex [split [dict get $o -errorinfo] \n] 0]
	}
    }
    return [string trim $v]
}

proc ::kettle::path::revision.fossil {path} {
    set fossilcmd [auto_execok fossil]
    if {[llength $fossilcmd]} {
	in $path {
	    set info [::exec {*}$fossilcmd info]
	}
	return [lindex [grep {checkout:*} $info] 0 1]
    } else {
	return Unknown
    }
}

proc ::kettle::path::is.git {path} {
    set control $path/.git
    expr {[file exists $control] && [file isdirectory $control]}
}

Changes to tcl.tcl.

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
		set mdfile [meta write $mdfile package $pn $pv]

		path install-file-group \
		    "package $pn $pv" \
		    $pkgdir {*}$files $indexfile {*}$mdfile

	    } finally {
		file delete $indexfile
		file delete $mdfile
		file delete -force $tmpdir
	    }
	}
    } $pkgdir $root $files $pn $pv

    recipe define uninstall-package-$pn "Uninstall package $pn $pv" {pkgdir pn pv} {
	path uninstall-file-group "package $pn $pv" $pkgdir
    } $pkgdir $pn $pv






|
|
|







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
		set mdfile [meta write $mdfile package $pn $pv]

		path install-file-group \
		    "package $pn $pv" \
		    $pkgdir {*}$files $indexfile {*}$mdfile

	    } finally {
		catch { file delete $indexfile }
		catch { file delete $mdfile }
		catch { file delete -force $tmpdir }
	    }
	}
    } $pkgdir $root $files $pn $pv

    recipe define uninstall-package-$pn "Uninstall package $pn $pv" {pkgdir pn pv} {
	path uninstall-file-group "package $pn $pv" $pkgdir
    } $pkgdir $pn $pv