[109463] branches/gsoc13-tests/src/macports1.0/tests
marius at macports.org
marius at macports.org
Thu Aug 15 15:37:40 PDT 2013
Revision: 109463
https://trac.macports.org/changeset/109463
Author: marius at macports.org
Date: 2013-08-15 15:37:39 -0700 (Thu, 15 Aug 2013)
Log Message:
-----------
macports1.0: remove old tests
Removed Paths:
-------------
branches/gsoc13-tests/src/macports1.0/tests/macports_dlist.tcl
branches/gsoc13-tests/src/macports1.0/tests/macports_util.tcl
Deleted: branches/gsoc13-tests/src/macports1.0/tests/macports_dlist.tcl
===================================================================
--- branches/gsoc13-tests/src/macports1.0/tests/macports_dlist.tcl 2013-08-15 22:10:00 UTC (rev 109462)
+++ branches/gsoc13-tests/src/macports1.0/tests/macports_dlist.tcl 2013-08-15 22:37:39 UTC (rev 109463)
@@ -1,114 +0,0 @@
-#!/usr/bin/env tclsh
-# macports1.0/test_dlist.tcl
-# $Id$
-#
-# Copyright (c) 2007 The MacPorts Project
-# Copyright (c) 2003 Kevin Van Vechten <kevin at opendarwin.org>
-
-# Test suite for macports_dlist package.
-
-#lappend auto_path .
-#package require macports_dlist 1.0
-source macports_dlist.tcl
-
-puts ""
-puts "Testing ditem"
-
-puts -nonewline "Checking ditem_create... "
-if {[catch {ditem_create} ditem] || $ditem == ""} {
- puts "failed: $ditem"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking ditem_key... "
-if {[catch {ditem_key $ditem provides "foo"} value] || $value != "foo"} {
- puts "failed: $value"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking ditem_append... "
-if {[catch {ditem_append $ditem provides "bar"} value] || $value != {foo bar}} {
- puts "failed: $value"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking ditem_contains... "
-set value2 ""
-if {[catch {ditem_contains $ditem provides "foo"} value] || $value != 1 ||
- [catch {ditem_contains $ditem provides "zzz"} value2] || $value2 != 0} {
- puts "failed: ${value}\n${value2}"
-} else {
- puts "ok"
-}
-
-puts ""
-puts "Testing dlist"
-
-puts -nonewline "Checking dlist_search... "
-if {[catch {dlist_search [list $ditem] provides "bar"} value] || $value != $ditem} {
- puts "failed: $value"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking dlist_has_pending... "
-if {[catch {dlist_has_pending [list $ditem] "foo"} value] || $value != 1} {
- puts "failed: $value"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking dlist_count_unmet... "
-array set status [list foo 1 bar 0]
-if {[catch {dlist_count_unmet [list] status "foo"} value] || $value != 0 ||
- [catch {dlist_count_unmet [list] status "bar"} value2] || $value2 != 1} {
- puts "failed: ${value}\n${value2}"
-} else {
- puts "ok"
-}
-
-# Replicate Shantonu's Bug #354 to test dlist functionality.
-# https://trac.macports.org/ticket/354
-# A depends on B, C.
-# B depends on C.
-# C has no dependencies.
-
-set A [ditem_create]
-ditem_key $A provides A
-ditem_append $A requires B
-ditem_append $A requires C
-
-set B [ditem_create]
-ditem_key $B provides B
-ditem_append $B requires C
-
-set C [ditem_create]
-ditem_key $C provides C
-
-array set status [list]
-puts -nonewline "Checking dlist_get_next... "
-if {[catch {dlist_get_next [list $A $B $C] status} value] || $value != $C} {
- puts "failed: ${value}"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking dlist_eval... "
-proc handler {ditem} { puts -nonewline "[ditem_key $ditem provides] " }
-if {[catch {dlist_eval [list $A $B $C] {} handler} value] || $value != {}} {
- puts "failed: ${value}"
-} else {
- puts "ok"
-}
-
-puts -nonewline "Checking dlist_append_dependents... "
-if {[catch {dlist_append_dependents [list $A $B $C] $B {}} value] || $value != [list $B $C]} {
- puts "failed: ${value}"
-} else {
- puts "ok"
-}
-
-
Deleted: branches/gsoc13-tests/src/macports1.0/tests/macports_util.tcl
===================================================================
--- branches/gsoc13-tests/src/macports1.0/tests/macports_util.tcl 2013-08-15 22:10:00 UTC (rev 109462)
+++ branches/gsoc13-tests/src/macports1.0/tests/macports_util.tcl 2013-08-15 22:37:39 UTC (rev 109463)
@@ -1,476 +0,0 @@
-# test_util.tcl
-# $Id$
-#
-# Comprehensive test file for macports_util.tcl
-# Written by Kevin Ballard <eridius at macports.org>
-
-source ./macports_util.tcl
-
-array set options {t 0 w 0}
-
-set ::traceNest ""
-set ::traceSquelch 0
-set ::traceSquelchNest ""
-proc dotrace {args} {
- global traceNest options
- flush stdout
- set command [lindex $args 0]
- if {$options(w) > 0} {
- # trim command to 1 line
- if {[llength [set lines [split $command "\n"]]] > 1} {
- set command "[lindex $lines 0] [ansi fg-blue]...[ansi reset]"
- }
- }
- set op [lindex $args end]
- switch $op {
- enter { append traceNest "#" }
- enterstep { append traceNest "+" }
- }
- switch $op {
- enter {
- puts stderr "[ansi fg-yellow inverse]$traceNest>[ansi reset] $command"
- set ::traceSquelch 0
- }
- enterstep {
- if {!$::traceSquelch} {
- puts stderr "[ansi fg-yellow]$traceNest>[ansi reset] $command"
- if {[llength [info procs [lindex [split $command] 0]]] > 0} {
- # it's a proc, lets start squelching
- set ::traceSquelch 1
- set ::traceSquelchNest $::traceNest
- }
- }
- }
- leave -
- leavestep {
- if {$op eq "leavestep" && $::traceSquelch && $::traceNest eq $::traceSquelchNest} {
- set ::traceSquelch 0
- }
- if {$op eq "leave" || !$::traceSquelch} {
- set code [lindex $args 1]
- set result [lindex $args 2]
- if {$options(w) > 0} {
- # trim result just like command
- if {[llength [set lines [split $result "\n"]]] > 1} {
- set result "[lindex $lines 0] [ansi fg-blue]...[ansi reset]"
- }
- }
- if {$op eq "leave"} {
- set prefix "[ansi fg-blue inverse]$traceNest"
- } else {
- set prefix "[ansi fg-blue]$traceNest"
- }
- if {$code != 0} {
- puts stderr "$prefix =\[$code\]>[ansi reset] $result"
- } else {
- puts stderr "$prefix =>[ansi reset] $result"
- }
- }
- }
- }
- switch $op {
- leave -
- leavestep {
- set traceNest [string range $traceNest 0 end-1]
- }
- }
-}
-while {[llength $argv] > 0} {
- set arg [lshift argv]
- if {$arg eq "--"} {
- break
- } elseif {[string match -* $arg]} {
- set arg [string range $arg 1 end]
- while {[string length $arg] > 0} {
- set opt [string index $arg 0]
- set arg [string range $arg 1 end]
- switch $opt {
- t { incr options(t) }
- w { incr options(w) }
- default {
- error "Unknown option: -$opt"
- }
- }
- }
- } else {
- lunshift argv $arg
- break
- }
-}
-if {$options(t) > 0} {
- set ops {enter leave}
- if {$options(t) > 1} {
- lappend ops enterstep leavestep
- }
- set util_list {ldindex lpop lpush lshift lunshift try throw}
- if {[llength $argv] > 0} {
- set list $argv
- if {[set idx [lsearch -exact $list *]] != -1} {
- set list [eval lreplace [list $list] $idx $idx $util_list]
- }
- } else {
- set list $util_list
- }
- foreach arg $list {
- trace add execution $arg $ops dotrace
- }
-}
-
-proc init {name value} {
- set name [list $name]
- set value [list $value]
- uplevel 1 [subst -nocommands {
- set $name $value
- set $name-bak [set $name]
- }]
-}
-
-proc restore {name} {
- set name [list $name]
- uplevel 1 [subst -nocommands {
- if {[info exists $name-bak]} {
- set $name [set $name-bak]
- } else {
- unset $name
- }
- }]
-}
-
-array set kStateToAnsiTable {
- error fg-magenta
- expected fg-cyan
- correct fg-green
- wrong fg-red
-}
-
-array set kAnsiTable {
- reset 0
-
- bold 1
- dim 2
- underline 4
- blink 5
- inverse 7
- hidden 8
-
- fg-black 30
- fg-red 31
- fg-green 32
- fg-yellow 33
- fg-blue 34
- fg-magenta 35
- fg-cyan 36
- fg-white 37
- fg-default 39
-
- bg-black 40
- bg-red 41
- bg-green 42
- bg-yellow 43
- bg-blue 44
- bg-magenta 45
- bg-cyan 46
- bg-white 47
- bg-default 49
-}
-
-proc ansi {args} {
- global kAnsiTable
- if {[llength $args] == 0} {
- error "wrong # args: should be \"ansi code ...\""
- }
- set colors {}
- foreach code $args {
- lappend colors $kAnsiTable($code)
- }
- return "\033\[[join $colors ";"]m"
-}
-
-proc state {code} {
- global kStateToAnsiTable
- return [ansi $kStateToAnsiTable($code)]
-}
-
-proc line {cmd expected args} {
- uplevel 1 [list block $cmd $cmd $expected] $args
-}
-
-proc block {name cmd expected args} {
- if {[set err [catch {uplevel 1 $cmd} value]]} {
- set savedErrorInfo $::errorInfo
- set savedErrorCode $::errorCode
- if {$expected eq "-error" && $err == 1} {
- if {[llength $args] > 0} {
- set errCode [lindex $args 0]
- if {$errCode == $savedErrorCode} {
- if {[llength $args] > 1} {
- set errMsg [lindex $args 1]
- if {$errMsg == $value} {
- set code expected
- } else {
- set code error
- }
- } else {
- set code expected
- }
- } else {
- set code error
- }
- } else {
- set code expected
- }
- } elseif {$expected eq "-return" && $err == 2} {
- if {[llength $args] > 0} {
- set errMsg [lindex $args 0]
- if {$errMsg == $value} {
- set code expected
- } else {
- set code error
- }
- } else {
- set code expected
- }
- } elseif {$expected eq "-break" && $err == 3} {
- set code expected
- } else {
- set code error
- }
- } elseif {$value == $expected} {
- set code correct
- } else {
- set code wrong
- }
- if {$code eq "error"} {
- append value "\n$savedErrorInfo"
- }
- puts "[state $code]$name =[if {$err != 0} {format \[$err\]}]> $value[ansi reset]"
-}
-
-proc var {name expected} {
- set exists [uplevel 1 info exists [list $name]]
- if {!$exists} {
- set value "does not exist"
- if {$expected eq "-unset"} {
- set code expected
- } else {
- set code error
- }
- } else {
- set value [uplevel 1 set [list $name]]
- if {$value == $expected} {
- set code correct
- } else {
- set code wrong
- }
- }
- puts "[state $code]$name: $value[ansi reset]"
-}
-
-if {[set err [catch {
- namespace eval test {
- namespace eval vars {}
- init vars::ary(one) {1 2 {3 4}}
- init vars::ary(zero) {1 {2 3 {"4 5" 6} 7} 8 9}
-
- var vars::ary(zero) {1 {2 3 {"4 5" 6} 7} 8 9}
- line {ldindex vars::ary(zero) 1 2 0} {4 5}
- var vars::ary(zero) {1 {2 3 6 7} 8 9}
- line {ldindex vars::ary(zero) 1 1 0} 3
- var vars::ary(zero) {1 {2 {} 6 7} 8 9}
- line {ldindex vars::ary(zero) 1 2} 6
- var vars::ary(zero) {1 {2 {} 7} 8 9}
- line {ldindex vars::ary(zero) 1} {2 {} 7}
- var vars::ary(zero) {1 8 9}
- line {ldindex vars::ary(zero)} {1 8 9}
- var vars::ary(zero) {}
-
- var vars::ary(one) {1 2 {3 4}}
- line {lpop vars::ary(one)} {3 4}
- var vars::ary(one) {1 2}
- line {lpop vars::ary(one)} 2
- var vars::ary(one) 1
- line {lpop vars::ary(one)} 1
- var vars::ary(one) {}
- line {lpop vars::ary(one)} {}
- var vars::ary(one) {}
-
- line {lpop vars::foo} -error NONE {can't read "vars::foo": no such variable}
-
- restore vars::ary(one)
- var vars::ary(one) {1 2 {3 4}}
- line {lshift vars::ary(one)} 1
- var vars::ary(one) {2 {3 4}}
- line {lshift vars::ary(one)} 2
- var vars::ary(one) {{3 4}}
- line {lshift vars::ary(one)} {3 4}
- var vars::ary(one) {}
- line {lshift vars::ary(one)} {}
- var vars::ary(one) {}
-
- line {lshift vars::foo} -error NONE {can't read "vars::foo": no such variable}
-
- var vars::ary(two) -unset
- line {lpush vars::ary(two) 1} 1
- var vars::ary(two) 1
- line {lpush vars::ary(two) 2 3 4 5} {1 2 3 4 5}
- var vars::ary(two) {1 2 3 4 5}
- line {lpush vars::ary(two) "this is a test"} {1 2 3 4 5 {this is a test}}
- var vars::ary(two) {1 2 3 4 5 {this is a test}}
- line {lpop vars::ary(two)} {this is a test}
- var vars::ary(two) {1 2 3 4 5}
-
- line {lpush "foo bar" 3} {3}
- var {foo bar} 3
-
- restore vars::ary(two)
- var vars::ary(two) -unset
- line {lunshift vars::ary(two) 5} 5
- var vars::ary(two) 5
- line {lunshift vars::ary(two) 4} {4 5}
- var vars::ary(two) {4 5}
- line {lunshift vars::ary(two) 1 2 3} {1 2 3 4 5}
- var vars::ary(two) {1 2 3 4 5}
- line {lunshift vars::ary(two) "this is a test"} {{this is a test} 1 2 3 4 5}
- var vars::ary(two) {{this is a test} 1 2 3 4 5}
- line {lshift vars::ary(two)} {this is a test}
- var vars::ary(two) {1 2 3 4 5}
-
- # now test the try/throw stuff
- line {throw} -error NONE {error: throw with no parameters outside of a catch}
- line {throw 1 2 3 4} -error NONE {wrong # args: should be "throw ?type? ?message? ?info?"}
- line {try {format 3} catch {} {}} -error NONE {invalid syntax in catch clause: type-list must contain at least one type}
- line {try {format 3} finally {format 4} test} -error NONE {trailing args after finally clause}
- block {basic try} {
- try {
- error "random error"
- }
- } -error NONE "random error"
- block {try-finally} {
- try {
- error "try-finally error"
- } finally {
- set myVar "finally clause worked"
- }
- } -error NONE "try-finally error"
- var myVar "finally clause worked"
- block {try-finally-error} {
- try {
- error "try-finally error"
- } finally {
- error "finally error"
- }
- } -error NONE "finally error"
- block {try-catch} {
- try {
- error "try-catch error"
- } catch NONE {
- format "catch clause worked"
- }
- } "catch clause worked"
- block {try-catch-throw} {
- try {
- error "try-catch error"
- } catch NONE {
- set myVar "thrown"
- throw
- }
- } -error NONE "try-catch error" ;# really should test errorInfo but that's messy
- var myVar "thrown"
- unset myVar
- block {try-catch-finally} {
- try {
- error "try-catch-finally error"
- } catch NONE {
- set myVar "thrown"
- throw
- } finally {
- lappend myVar "finally"
- }
- } -error NONE "try-catch-finally error"
- var myVar "thrown finally"
- block {try-catch-all} {
- try {
- error "this is a test"
- } catch * {
- format "catch-all worked"
- }
- } "catch-all worked"
- block {try-catch-return} {
- try {
- error "this is a test"
- } catch * {
- return "catch-return worked"
- }
- } -return "catch-return worked"
- block {try-catch-break} {
- try {
- error "this is a test"
- } catch * {
- break
- }
- } -break
- block {try-catch-multiple} {
- try {
- error "this is a test"
- } catch POSIX {
- error "POSIX catch"
- } catch * {
- format "catch-all"
- }
- } "catch-all"
- unset myVar
- block {try-catch-multiple-finally} {
- try {
- error "this is a test"
- } catch * {
- lappend myVar "catch-all 1"
- } catch * {
- lappend myVar "catch-all 2"
- } finally {
- lappend myVar "finally"
- }
- } [list {catch-all 1}]
- var myVar [list "catch-all 1" "finally"]
- block {try-catch-types} {
- try {
- error "try-catch-types error" {} {MYERR arg1 arg2}
- } catch POSIX {
- error "POSIX catch"
- } catch {{MY* arg*} code} {
- format "caught code $code"
- }
- } "caught code MYERR arg1 arg2"
- block {try-catch-vars} {
- try {
- error "random error"
- } catch {* code msg info} {
- set list {}
- if {$code eq "NONE"} {
- lappend list "code: correct"
- }
- if {$msg eq "random error"} {
- lappend list "msg: correct"
- }
- if {[string match "random error\n*" $info]} {
- lappend list "info: probably correct"
- }
- join $list ", "
- }
- } "code: correct, msg: correct, info: probably correct"
- block {try-break-catch} {
- try {
- break
- } catch {*} {
- error "catch triggered"
- }
- } -break
-
- # ensure the stack is sound
- var ::_trycatch::catchStack {}
- }
-} result]]} {
- puts ""
- puts "error: $result"
- puts "code: $err"
- puts $::errorInfo
-}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20130815/ca2223c9/attachment-0001.html>
More information about the macports-changes
mailing list