Subversion Repositories or1k_old

# Commands covered:  none

#

# This file contains a collection of tests for Tcl_LinkVar and related

# library procedures.  Sourcing this file into Tcl runs the tests and

# generates output for errors.  No output means no errors were found.

#

# Copyright (c) 1993 The Regents of the University of California.

# Copyright (c) 1994 Sun Microsystems, Inc.

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# RCS: @(#) $Id: link.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $

if {[info commands testlink] == {}} {

    puts "This application hasn't been compiled with the \"testlink\""

    puts "command, so I can't test Tcl_LinkVar et al."

    return

}

if {[string compare test [info procs test]] == 1} then {source defs}

foreach i {int real bool string} {

    catch {unset $i}

}

test link-1.1 {reading C variables from Tcl} {

    testlink delete

    testlink set 43 1.23 4 -

    testlink create 1 1 1 1

    list $int $real $bool $string

} {43 1.23 1 NULL}

test link-1.2 {reading C variables from Tcl} {

    testlink delete

    testlink create 1 1 1 1

    testlink set -3 2 0 "A long string with spaces"

    list $int $real $bool $string $int $real $bool $string

} {-3 2.0 0 {A long string with spaces} -3 2.0 0 {A long string with spaces}}

test link-2.1 {writing C variables from Tcl} {

    testlink delete

    testlink set 43 1.21 4 -

    testlink create 1 1 1 1

    set int "00721"

    set real -10.5

    set bool true

    set string abcdef

    concat [testlink get] $int $real $bool $string

} {465 -10.5 1 abcdef 00721 -10.5 true abcdef}

test link-2.2 {writing bad values into variables} {

    testlink delete

    testlink set 43 1.23 4 -

    testlink create 1 1 1 1

    list [catch {set int 09a} msg] $msg $int

} {1 {can't set "int": variable must have integer value} 43}

test link-2.3 {writing bad values into variables} {

    testlink delete

    testlink set 43 1.23 4 -

    testlink create 1 1 1 1

    list [catch {set real 1.x3} msg] $msg $real

} {1 {can't set "real": variable must have real value} 1.23}

test link-2.4 {writing bad values into variables} {

    testlink delete

    testlink set 43 1.23 4 -

    testlink create 1 1 1 1

    list [catch {set bool gorp} msg] $msg $bool

} {1 {can't set "bool": variable must have boolean value} 1}

test link-3.1 {read-only variables} {

    testlink delete

    testlink set 43 1.23 4 -

    testlink create 0 1 1 0

    list [catch {set int 4} msg] $msg $int \

        [catch {set real 10.6} msg] $msg $real \

        [catch {set bool no} msg] $msg $bool \

        [catch {set string "new value"} msg] $msg $string

} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL}

test link-3.2 {read-only variables} {

    testlink delete

    testlink set 43 1.23 4 -

    testlink create 1 0 0 1

    list [catch {set int 4} msg] $msg $int \

        [catch {set real 10.6} msg] $msg $real \

        [catch {set bool no} msg] $msg $bool \

        [catch {set string "new value"} msg] $msg $string

} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value}}

test link-4.1 {unsetting linked variables} {

    testlink delete

    testlink set -6 -2.5 0 stringValue

    testlink create 1 1 1 1

    unset int real bool string

    list [catch {set int} msg] $msg [catch {set real} msg] $msg \

            [catch {set bool} msg] $msg [catch {set string} msg] $msg

} {0 -6 0 -2.5 0 0 0 stringValue}

test link-4.2 {unsetting linked variables} {

    testlink delete

    testlink set -6 -2.1 0 stringValue

    testlink create 1 1 1 1

    unset int real bool string

    set int 102

    set real 16

    set bool true

    set string newValue

    testlink get

} {102 16.0 1 newValue}

test link-5.1 {unlinking variables} {

    testlink delete

    testlink set -6 -2.25 0 stringValue

    testlink delete

    set int xx1

    set real qrst

    set bool bogus

    set string 12345

    testlink get

} {-6 -2.25 0 stringValue}

test link-5.2 {unlinking variables} {

    testlink delete

    testlink set -6 -2.25 0 stringValue

    testlink create 1 1 1 1

    testlink delete

    testlink set 25 14.7 7 -

    list $int $real $bool $string

} {-6 -2.25 0 stringValue}

test link-6.1 {errors in setting up link} {

    testlink delete

    catch {unset int}

    set int(44) 1

    list [catch {testlink create 1 1 1 1} msg] $msg

} {1 {can't set "int": variable is array}}

catch {unset int}

test link-7.1 {access to linked variables via upvar} {

    proc x {} {

        upvar int y

        unset y

    }

    testlink delete

    testlink create 1 0 0 0

    testlink set 14 {} {} {}

    x

    list [catch {set int} msg] $msg

} {0 14}

test link-7.2 {access to linked variables via upvar} {

    proc x {} {

        upvar int y

        return [set y]

    }

    testlink delete

    testlink create 1 0 0 0

    testlink set 0 {} {} {}

    set int

    testlink set 23 {} {} {}

    x

    list [x] $int

} {23 23}

test link-7.3 {access to linked variables via upvar} {

    proc x {} {

        upvar int y

        set y 44

    }

    testlink delete

    testlink create 0 0 0 0

    testlink set 11 {} {} {}

    list [catch x msg] $msg $int

} {1 {can't set "y": linked variable is read-only} 11}

test link-7.4 {access to linked variables via upvar} {

    proc x {} {

        upvar int y

        set y abc

    }

    testlink delete

    testlink create 1 1 1 1

    testlink set -4 {} {} {}

    list [catch x msg] $msg $int

} {1 {can't set "y": variable must have integer value} -4}

test link-7.5 {access to linked variables via upvar} {

    proc x {} {

        upvar real y

        set y abc

    }

    testlink delete

    testlink create 1 1 1 1

    testlink set -4 16.75 {} {}

    list [catch x msg] $msg $real

} {1 {can't set "y": variable must have real value} 16.75}

test link-7.6 {access to linked variables via upvar} {

    proc x {} {

        upvar bool y

        set y abc

    }

    testlink delete

    testlink create 1 1 1 1

    testlink set -4 16.3 1 {}

    list [catch x msg] $msg $bool

} {1 {can't set "y": variable must have boolean value} 1}

test link-8.1 {Tcl_UpdateLinkedVar procedure} {

    proc x args {

        global x int real bool string

        lappend x $args $int $real $bool $string

    }

    set x {}

    testlink create 1 1 1 1

    testlink set 14 -2.0 0 xyzzy

    trace var int w x

    testlink update 32 4.0 3 abcd

    trace vdelete int w x

    set x

} {{int {} w} 32 -2.0 0 xyzzy}

test link-8.2 {Tcl_UpdateLinkedVar procedure} {

    proc x args {

        global x int real bool string

        lappend x $args $int $real $bool $string

    }

    set x {}

    testlink create 1 1 1 1

    testlink set 14 -2.0 0 xyzzy

    testlink delete

    trace var int w x

    testlink update 32 4.0 6 abcd

    trace vdelete int w x

    set x

} {}

test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {

    testlink create 0 0 0 0

    list [catch {testlink update 47 {} {} {}} msg] $msg $int

} {0 {} 47}

testlink delete

foreach i {int real bool string} {

    catch {unset $i}

}