OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [tests/] [pushbutton.test] - Rev 1765

Compare with Previous | Blame | View Log

# This file is a Tcl script to test out [incr Widgets] Pushbutton class.
# It is organized in the standard fashion for Tcl tests with the following
# notation for test case labels:
#
#   1.x - Construction/Destruction tests
#   2.x - Configuration option tests
#   3.x - Method tests
#
# Copyright (c) 1995 DSC Technologies Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) $Id: pushbutton.test,v 1.1.1.1 2002-01-16 10:24:51 markom Exp $

package require Iwidgets 3.0

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

wm geometry . {}
raise .

set c 1
set o 1
set m 1

#
# Initial construction test
#
test Pushbutton-1.$c {Pushbutton construction} {
    iwidgets::Pushbutton .pb 
    pack .pb -padx 10 -pady 10
    image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
    update 
} {}

incr c

#
# Option tests which are successful.
#
test Pushbutton-2.$o {configuration option} {
    llength [.pb configure]
} {27}

incr o

foreach test {
        {-activebackground #ececec #ececec}
        {-activeforeground Black Black} 
        {-background #d9d9d9 #d9d9d9}
        {-borderwidth 2 2}
        {-command {.pb configure -background Red} {.pb configure -background Red}}
        {-defaultring 1 1} 
        {-text Hello Hello}
        {-width 100 100}
        {-bitmap error error} 
        {-image flagup flagup}
        {-defaultring 0 0} 
        {-padx 10 10} 
        {-padx 8 8} 
        {-pady 8 8} 
        {-pady 4 4} 
        {-image {} {}}
        {-cursor gumby gumby} 
        {-bitmap {} {}}
        {-font 6x13 6x13} 
        {-foreground Black Black} 
        {-height 70 70} 
        {-width 100 100}
        {-underline 0 0}
        {-highlightthickness 3 3}
        {-highlightcolor blue blue} 
        {-highlightcolor black black} 
        {-highlightthickness 2 2}
        {-state disabled disabled} 
        {-state normal normal} 
        {-defaultringpad 6 6}
        {-width 120 120}} {
        set option [lindex $test 0]
        test Pushbutton-2.$o "configuration options, $option" {
            .pb configure $option [lindex $test 1]
            lindex [.pb configure $option] 4
        } [lindex $test 2]
        update 
        incr o
}

#
# Method tests which are successful.
#
foreach test {
    {{.pb flash} {}}
    {{.pb invoke} {}}} {
        set method [lindex [lindex $test 0] 1]
        test Pushbutton-3.$m "object methods, $method" {
            list [catch {eval [lindex $test 0]} msg] $msg
        } [list 0 [lindex $test 1]]
        update 
        incr m
}

#
# Conclusion of constrcution/destruction tests
#
test Pushbutton-1.$c {Pushbutton destruction} {
    destroy .pb
    update 
    image delete flagup
} {}

incr c

test Pushbutton-1.$c {Pushbutton construction} {
    iwidgets::pushbutton .pb -text "Push Button" -defaultring yes 
    pack .pb -padx 10 -pady 10 
    update 
} {}

incr c

test Pushbutton-1.$c {Pushbutton destruction} {
    destroy .pb
    update 
} {}

incr c

test Pushbutton-1.$c {Pushbutton destruction} {
    iwidgets::pushbutton .pb
    pack .pb
    destroy .pb
    update 
} {}

Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.