#
# Tests for creating and using class instance objects.
#
# Copyright (c) 1997-1998 Mark Diekhans
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: object.test,v 1.16 1998/06/25 09:49:08 markd Exp $
#

if {[info procs test] != "test"} then {source testlib.tcl}

catch {namespace delete ::Sterno}
source ../library/object.tcl
source ../library/class.tcl
source ../library/instance.tcl

TestReg object-1.0 {creating objects} {
    set c1 [::Sterno::defClass {} {
        method construct {v} {
            set c1f2 $v
        }
        field c1f1 C1F1
        field c1f2 C1F2
        method c1m1 {} {
            return "C1M1: c1f1=$c1f1"
        }
        method c1m2 a {
            return "C1M2: $a: c1f2=$c1f2"
        }
    }]
} 0 {^::Sterno::Class[0-9]+::___call$}

TestReg object-1.1 {creating objects} {
    set o1 [$c1 new "Object 1"]
} 0 {^::Sterno::Class[0-9]+::obj[0-9]+::___call$}

TestReg object-1.2 {creating objects} {
    set o2 [$c1 new "Object 2"]
} 0 {^::Sterno::Class[0-9]+::obj[0-9]+::___call$}

Test object-1.3 {creating objects} {
    list [$o1 fget c1f1] [$o1 fget c1f2] [$o2 fget c1f1] [$o2 fget c1f2]
} 0 {C1F1 {Object 1} C1F1 {Object 2}}

Test object-2.1 {calling object methods} {
    $o1 c1m1
} 0 {C1M1: c1f1=C1F1}

Test object-2.2 {calling object methods} {
    $o1 c1m2 One
} 0 {C1M2: One: c1f2=Object 1}

Test object-2.3 {calling object methods} {
    $o1 c1m2 Two
} 0 {C1M2: Two: c1f2=Object 1}

Test object-3.1 {accessing objects} {
    $o1 fset c1f1 "o1 c1f1 modified"
    $o2 fset c1f2 "o2 c1f2 modified"
    list [$o1 fget c1f1] [$o1 fget c1f2] [$o2 fget c1f1] [$o2 fget c1f2]
} 0 {{o1 c1f1 modified} {Object 1} C1F1 {o2 c1f2 modified}}

Test object-3.2 {accessing objects} {
    $o2 fset c1f2 "o2 c1f2 modified"
    list [$o2 fget c1f1] [$o2 fget c1f2]
} 0 {C1F1 {o2 c1f2 modified}}

Test object-3.2 {accessing objects} {
    lsort [$o2 fields]
} 0 {c1f1 c1f2 class self selfns}

TestReg object-4.0 {deleting objects} {
    $o1 delete
    $o1 fget c1f1
} 1 {^invalid command name "::Sterno::Class[0-9]+::obj0::___call"$}

Test object-4.1 {deleting objects} {
    set c2 [::Sterno::defClass {} {
        method destruct {} {
            global destructState
            set destructState "I am destroyed"
        }
    }]
    set o2 [$c2 new]
    global destructState
    set destructState "I am alive"
    $o2 delete
    set destructState
} 0 {I am destroyed}

Test object-4.2 {deleting objects} {
    global destructState
    set destructState "Still dead?"
    $c2 delete
    set destructState
} 0 {Still dead?}

TestReg object-5.0 {field imports} {
    ::Sterno::defClass ImportTest {
        field fld1 not1
        field fld2 not2
        method sfld1 {} {
            set fld1 set1
        }
        method sfld2 {} {
            set fld2 set2
        }
        method getSelf {} {
            return $self
        }
        method getClass {} {
            variable class
            return $class
        }
    }
    set testObj [ImportTest new]
} 0 {^::Sterno::Class[0-9]+::obj[0-9]+::___call$}

Test object-5.1 {field imports} {
    set before [list [$testObj fget fld1] [$testObj fget fld2]]
    $testObj sfld1
    $testObj sfld2
    set after [list [$testObj fget fld1] [$testObj fget fld2]]
    list $before $after
} 0 {{not1 not2} {set1 set2}}

TestReg object-5.2 {field imports} {
    set s [$testObj getSelf]
    list [string compare $s $testObj] $s
} 0 {0 ::Sterno::Class[0-9]+::obj[0-9]+::___call$}

TestReg object-5.3 {field imports} {
    $testObj getClass
} 0 {^::Sterno::Class[0-9]+::___call$}

TestReg object-5.6 {field imports} {
    ImportTest delete
    $testObj getClass
} 1 {^invalid command name "::Sterno::Class[0-9]+::obj[0-9]+::___call"$}

TestReg object-6.0 {local objects} {
    catch {namespace delete ::SternoTests}
    ::Sterno::defClass ::LocalObjTest {
        field name {}
        method construct nameArg {
            $self fset name $nameArg
        }
        method foo {} {
            variable name
            return "I am [namespace current], $name"
        }
    }
    set lo1 [namespace eval ::SternoTests {::LocalObjTest localNew "Number one"}]
} 0 {^::SternoTests::Sterno::Class[0-9]+::obj[0-9]+::___call$}

TestReg object-6.1 {local objects} {
    $lo1 foo
} 0 {^I am ::SternoTests::Sterno::Class[0-9]+::obj[0-9]+, Number one$}

TestReg object-6.2 {local objects} {
    namespace delete ::SternoTests
    $lo1 foo
} 1 {^invalid command name "::SternoTests::Sterno::Class[0-9]+::obj[0-9]+::___call"$}

TestReg object-6.3 {local objects} {
    set lo2 [namespace eval ::SternoTests {::LocalObjTest localNew "Number two"}]
    $lo2 foo
} 0 {^I am ::SternoTests::Sterno::Class[0-9]+::obj[0-9]+, Number two$}

TestReg object-6.4 {local objects} {
    ::LocalObjTest delete
    $lo2 foo
} 1 {^invalid command name "::SternoTests::Sterno::Class[0-9]+::obj[0-9]+::___call"$}

Test object-7.1 {array fields} {
    set c3 [::Sterno::defClass {} {
        field a1
        method construct {} {
            set a1(X) XXX
        }
    }]
    set c3o1 [$c3 new]
    $c3o1 fset a1(Y) YYY
    list [$c3o1 fget a1(X)] [$c3o1 fget a1(Y)]
} 0 {XXX YYY}

Test object-7.2 {array fields} {
    array names [$c3o1 fref a1]
} 0 {X Y}

Test object-7.3 {array fields} {
    $c3 delete
} 0 {}

TestReg object-8.0 {class methods} {
    set c4 [::Sterno::defClass {} {     
        variable classF1 "I am classF1"
        field instF1 "I am instF1"
        classMethod classM1 {} {
            variable classF1
            return "classM1: $classF1"
        }
        classMethod override1 {} {
            return "class overrider1"
        }
        method override1 {} {
            return "object overrider1"
        }
        method instM1 {} {
            return "instM1"
        }
    }]
} 0 {^::Sterno::Class[0-9]+::___call$}

Test object-8.1 {class methods} {
    $c4 classM1
} 0 {classM1: I am classF1}

Test object-8.2 {class methods} {
    $c4 override1
} 0 {class overrider1}

TestReg object-8.3 {class methods} {
    $c4 instM1
} 1 {^invalid command name "::Sterno::Class[0-9]+::instM1"$}

Test object-8.4 {class methods} {
    set o4 [$c4 new]
    $o4 classM1
} 0 {classM1: I am classF1}

Test object-8.5 {class methods} {
    $o4 override1
} 0 {object overrider1}

Test object-8.6 {class methods} {
    $o4 instM1
} 0 {instM1}


Test object-9.0 {fields} {
    # Bug setting empty variable.
    set c4 [::Sterno::defClass {} {
        field fld {}
        method getFld {} {
            variable fld
            return "Fld is \"$fld\""
        }
    }]
    set o4 [$c4 new]
    set value [$o4 getFld]
    $c4 delete
    set value
} 0 {Fld is ""}

