Skunkware 5/Skunkware 5.iso/src/Tools/ObjectTcl-1.1/tests/tscript

Text File | 1995-06-30 | 39.4 KB | 1,643 lines

#!../otcltest

# Test Script for Object Tcl

#
# Support routines for Test procedure
#
proc ResultCode code {
    switch $code {
        0 {return TCL_OK}
        1 {return TCL_ERROR}
        2 {return TCL_RETURN}
        3 {return TCL_BREAK}
        4 {return TCL_CONTINUE}
    }
    return "Invalid result code $code"
}

proc OutputTestError {id command expectCode expectResult resultCode result} {
    puts stderr "======== Test $id failed ========"
    puts stderr $command
    puts stderr "==== Result was: [ResultCode $resultCode]:"
    puts stderr $result
    puts stderr "==== Expected : [ResultCode $expectCode]:"
    puts stderr $expectResult
    puts stderr "===="
}

# Test Procedure used by all tests
# id is the test identifier
# code is the test scenario
# optional -dontclean argument will stop the test classes being cleaned out

proc Test {id command expectCode expectResult args} {
    set resultCode [catch {uplevel $command} result]

    if {($resultCode != $expectCode) ||
        ([string compare $result $expectResult] != 0)} {
        OutputTestError $id $command $expectCode $expectResult $resultCode \
                $result
    }

   if {[llength $args] == 0 || [lindex $args 0] != "-dontclean"} {
      # An un-documented command to clear out the Otcl classes,
      # only used here to making thinking of class names easier in testing
      # not recommended
      otcl clear
   }
}

global results

Test 1.1 {
   # Not enough args for otclInterface command
   otclInterface AClass
} 1 {wrong # args: should be "otclInterface className ?-isA classList? body"}

Test 1.2 {
   # Too many args for otclInterface command
   otclInterface AClass -isA AnotherClass {body} tooMany
} 1 {wrong # args: should be "otclInterface className ?-isA classList? body"}

Test 1.3 {
   # Illegal args for otclInterface
   otclInterface AClass blah {body}
} 1 {wrong # args: should be "otclInterface className ?-isA classList? body"}

Test 1.4 {
   # Illegal args for otclInterface
   otclInterface AClass -isA {}
} 1 {wrong # args: should be "otclInterface className ?-isA classList? body"}

Test 1.5 {
   # Illegal args for otclInterface as AClass doesn't exist
   otclInterface BClass -isA AClass {}
} 1 {Class "BClass" interface specified an unknown class, "AClass", as one of its superclasses.}

Test 1.6 {
   # Illegal args for otclInterface
   otclInterface BClass -isA {} {}
} 1 {Class "BClass" does not specify any classes in its -isA class list. Must specify at least one class with the -isA option.}

Test 1.7 {
   # Illegal args for otclInterface
   otclInterface AClass {}
   otclInterface BClass -isA AClass {}
} 1 {Class "BClass" interface specified an unknown class, "AClass", as one of its superclasses.}

Test 1.8 {
   # Illegal args for otclInterface
   otclInterface AClass {}
   otclInterface AClass {}
} 1 {Class "AClass" already declared.}

Test 1.9 {
   # Illegal arsg for otclInterface
   otclInterface AClass {}
   otclImplementation AClass {}
   otclInterface BClass -isA {AClass AClass} {}
} 1 {Class "AClass" is specified as a superclass of class "BClass" twice.}


Test 1.10 {
   # Too many superclasses
   otclInterface AClass {}
   otclImplementation AClass {}
   otclInterface BClass {}
   otclImplementation BClass {}
   otclInterface CClass {}
   otclImplementation CClass {}
   otclInterface DClass {}
   otclImplementation DClass {}
   otclInterface EClass -isA {AClass BClass CClass DClass} {}
} 1 {Too many superclasses specified in interface for class "EClass". Maximum is 3.}

Test 1.11 {
   # Not enough args for constructor
   otclInterface AClass {
      constructor
   }
} 1 {wrong # args: should be "constructor args"}

Test 1.12 {
   # Too many args for constructor
   otclInterface AClass {
      constructor {} extra
   }
} 1 {wrong # args: should be "constructor args"}

Test 1.13 {
   # Formal arguemnt error in constructor
   otclInterface AClass {
      constructor {arg {}}
   }
} 1 {Syntax error in formal argument 2 for method "AClass::constructor". Formal argument specification is "".}

Test 1.14 {
   # Formal argument error in constructor
   otclInterface AClass {
      constructor {arg1 {arg2 value extra}}
   }
} 1 {Syntax error in formal argument 2 for method "AClass::constructor". Formal argument specification is "arg2 value extra".}

Test 1.15 {
   # Duplicated arguments in constructor
   otclInterface AClass {
      constructor {arg1 arg1}
   }
} 1 {Duplicated formal argument "arg1" in method "AClass::constructor".}

Test 1.16 {
   # Not enough args for method
   otclInterface AClass {
      method
   }
} 1 {wrong # args: should be "method name args"}

Test 1.17 {
   # Too many args for method
   otclInterface AClass {
      method name args extra
   }
} 1 {wrong # args: should be "method name args"}

Test 1.18 {
   # Invalid name for method
   otclInterface AClass {
      method constructor {}
   }
} 1 {Cannot name an instance method "constructor".}

Test 1.19 {
   # Invalid name for method
   otclInterface AClass {
      method destructor {}
   }
} 1 {Cannot name an instance method "destructor".}

Test 1.20 {
   # Method duplicated in interface
   otclInterface AClass {
      method methodOne {}
      method methodOne {}
   }
} 1 {Method "methodOne" duplicated in interface for class "AClass".}

Test 1.21 {
   # Method duplicated in interface
   otclInterface AClass {
      classMethod methodOne {}
      method methodOne {}
   }
} 1 {Method "methodOne" duplicated in interface for class "AClass".}

Test 1.22 {
   # Not enough args for classMethod
   otclInterface AClass {
      classMethod
   }
} 1 {wrong # args: should be "classMethod name args"}

Test 1.23 {
   # Too many args for classMethod
   otclInterface AClass {
      classMethod name arg extra
   }
} 1 {wrong # args: should be "classMethod name args"}

Test 1.24 {
   # Invalid name for classMethod
   otclInterface AClasss {
      classMethod constructor {}
   }
} 1 {Cannot name a class method "constructor".}

Test 1.25 {
   # Invalid name for classMethod
   otclInterface AClass {
      classMethod destructor {}
   }
} 1 {Cannot name a class method "destructor".}

Test 1.26 {
   # Duplicate method in interface
   otclInterface AClass {
     classMethod methodOne {}
     classMethod methodOne {}
   }
} 1 {Method "methodOne" duplicated in interface for class "AClass".}

Test 1.27 {
   # Duplicate method in interface
   otclInterface AClass {
      method methodOne {}
      classMethod methodOne {}
   }
} 1 {Method "methodOne" duplicated in interface for class "AClass".}

Test 1.28 {
   # Invalid argument in method
   otclInterface AClass {
      method methodOne {{}}
   }
} 1 {Syntax error in formal argument 1 for method "AClass::methodOne". Formal argument specification is "".}

Test 2.1 {
   # Not enough args for otclImplementation
   otclImplementation
} 1 {wrong # args: should be "otclImplementation className body"}

Test 2.2 {
   # Too many arguments for otclImplementation
   # Max args only check after name has been checked
   otclInterface name {}
   otclImplementation name body extra
} 1 {wrong # args: should be "otclImplementation className body"}

Test 2.3 {
   # Illegal class name for otclImplementation
   otclImplementation AClass {}
} 1 {Class "AClass" interface has not been declared.}

Test 2.4 {
   # Duplicate implementation
   otclInterface AClass {}
   otclImplementation AClass {}
   otclImplementation AClass {}
} 1 {Class "AClass" has already been completely specified.}

Test 2.5 {
   # Not enough args for constructor implementation
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor
   }
} 1 {wrong # args: should be "constructor args parentConstructors body"}

Test 2.6 {
   # Too many args for constructor implementation
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor args parentList body extra
   }
} 1 {wrong # args: should be "constructor args parentConstructors body"}

Test 2.7 {
   # Diff # args from int to imp for constructor
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {arg1} {} {}
   }
} 1 {Method "AClass::constructor" has different number of arguments specified in its interface and implementation.}

Test 2.8 {
   # Diff # args from int to imp for constructor
   otclInterface AClass {
      constructor {arg1}
   }
   otclImplementation AClass {
      constructor {} {} {}
   }
} 1 {Method "AClass::constructor" has different number of arguments specified in its interface and implementation.}

Test 2.9 {
   # Default value for constructor specified in implementation
   otclInterface AClass {
      constructor {arg1}
   }
   otclImplementation AClass {
      constructor {{arg1 0}} {} {}
   }
} 1 {Method "AClass::constructor" has default values specified for formal arguments in its implementation. Can only specify defaults in interface if method is public.}

Test 2.10 {
   # Parent constructor bad syntax
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {} {{}} {}
   }
} 1 {Syntax error in parent constructor "" in constructor of class "AClass".}

Test 2.11 {
   # Parent constructor bad syntax
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {} {{bad}} {}
   }
} 1 {Syntax error in parent constructor "bad" in constructor of class "AClass".}

Test 2.12 {
   # Unknown class in parent construcopr
   otclInterface AClass {
     constructor {}
   }
   otclImplementation AClass {
      constructor {} {{BClass arg arg}} {}
   }
} 1 {Constructor of class "AClass" has specified an unknown class, "BClass", in its parent construction specifier.}

Test 2.13 {
   # Known but not inherited class in parent constructor
   otclInterface AClass {}
   otclImplementation AClass {}
   otclInterface BClass {
      constructor {}
   }
   otclImplementation BClass {
      constructor {} {{AClass asd asd asd}} {}
   }
} 1 {Constructor of class "BClass" has specified an unknown class, "AClass", in its parent construction specifier.}

Test 2.14 {
   # Duplication of parent constructor calls
   otclInterface AClass {}
   otclImplementation AClass {}
   otclInterface BClass -isA AClass {
      constructor {}
   }
   otclImplementation BClass {
      constructor {} {{AClass arg} {AClass arg}} {}
   }
} 1 {Duplication of parent construction parameters for class "AClass" from constructor of class "BClass".}

Test 2.15 {
   # Private constructor?
   otclInterface AClass {}
   otclImplementation AClass {
      constructor {} {} {}
   }
} 1 {Constructor for class "AClass" must be specified in interface.}

Test 2.16 {
   # Not enough args for method in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      method
   }
} 1 {wrong # args: should be "method name args body"}

Test 2.17 {
   # Too many args for method in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      method name args body extra
   }
} 1 {wrong # args: should be "method name args body"}

Test 2.18 {
   # Implemented as method but interfaced as classMethod
   otclInterface AClass {
      classMethod methodOne {}
   }
   otclImplementation AClass {
      method methodOne {} {}
   }
} 1 {Method "methodOne" specified as a class method in the interfaced but implemented as an instance method.}

Test 2.19 {
   # Too few args for classMethod in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      classMethod
   }
} 1 {wrong # args: should be "classMethod name args body"}

Test 2.20 {
   # Too many args to classMethod in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      classMethod name args body extra
   }
} 1 {wrong # args: should be "classMethod name args body"}

Test 2.21 {
   # Interfaced as instance and implemented as class method
   otclInterface AClass {
      method methodOne {}
   }
   otclImplementation AClass {
      classMethod methodOne {} {}
   }
} 1 {Method "methodOne" specified as an instance method in the interface but implemented as a class method.}

Test 2.22 {
   # Not enough args for attribute
   otclInterface AClass {}
   otclImplementation AClass {
      attribute
   }
} 1 {wrong # args: should be "attribute name ?initial?"}

Test 2.22.1 {
   # Too many args for attribute
   otclInterface AClass {}
   otclImplementation AClass {
      attribute name initial extra
   }
} 1 {wrong # args: should be "attribute name ?initial?"}

Test 2.22.2 {
   # Bad name for attribute
   otclInterface AClass {}
   otclImplementation AClass {
      attribute this
   }
} 1 {Attribute's cannot be called "this".}

Test 2.23 {
   # Duplicated instance attributes
   otclInterface AClass {}
   otclImplementation AClass {
      attribute attOne
      attribute attOne
   }
} 1 {Instance attribute "attOne" in class "AClass" clashes with another instance attribute of the same name.}

Test 2.24 {
   # Duplicated instance with class attribute
   otclInterface AClass {}
   otclImplementation AClass {
      classAttribute attOne 0
      attribute attOne
   }
} 1 {Instance attribute "attOne" in class "AClass" clashes with a class attribute of the same name.}

Test 2.25 {
   # Not enough args for classAttribute
   otclInterface AClass {}
   otclImplementation AClass {
      classAttribute
   }
} 1 {wrong # args: should be "classAttribute name initial"}

Test 2.26 {
   # Too many args for classAttribute
   otclInterface AClass {}
   otclImplementation AClass {
      classAttribute name initial extra
   }
} 1 {wrong # args: should be "classAttribute name initial"}

Test 2.27 {
   # Bad name for classAttribute
   otclInterface AClass {}
   otclImplementation AClass {
      classAttribute this 0
   }
} 1 {Attribute's cannot be called "this".}

Test 2.28 {
   # Duplicated class attribute
   otclInterface AClass {}
   otclImplementation AClass {
      classAttribute attOne 0
      classAttribute attOne 1
   }
} 1 {Class attribute "attOne" in class "AClass" clashes with another class attribute of the same name.}

Test 2.29 {
   # Class attribute classes with instance attribute
   otclInterface AClass {}
   otclImplementation AClass {
      attribute attOne
      classAttribute attOne 0
   }
} 1 {Class attribute "attOne" in class "AClass" clashes with an instance attribute of the same name.}

Test 2.30 {
   # Not enough args for destructor
   otclInterface AClass {}
   otclImplementation AClass {
      destructor
   }
} 1 {wrong # args: should be "destructor body"}

Test 2.31 {
   # Too many args for destructor
   otclInterface AClass {}
   otclImplementation AClass {
      destructor {body} extra
   }
} 1 {wrong # args: should be "destructor body"}

Test 2.32 {
  # Body duplicated in implementation
  otclInterface AClass {}
  otclImplementation AClass {
     method a {} {}
     method a {} {}
  }
} 1 {Method "AClass::a" implementated twice.}

Test 2.33 {
   # Body duplicated in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      method a {} {}
      classMethod a {} {}
   }
} 1 {Method "a" implementated twice.}

Test 2.34 {
   # Body duplicated in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      classMethod a {} {}
      classMethod a {} {}
   }
} 1 {Method "AClass::a" implementated twice.}

Test 2.35 {
   # Body duplicated in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      classMethod a {} {}
      method a {} {}
   }
} 1 {Method "a" implementated twice.}

Test 2.36 {
  # Class not completed
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
   }
} 1 {Instance method "constructor" of class "AClass" has not been completed. An interfaced method must be implemented.}

Test 2.37 {
   # Class not complete
   otclInterface AClass {
      method A {}
   }
   otclImplementation AClass {
   }
} 1 {Instance method "A" of class "AClass" has not been completed. An interfaced method must be implemented.}

Test 2.38 {
   # Class not complete
   otclInterface AClass {
      classMethod A {}
   }
   otclImplementation AClass {
   }
} 1 {Class method "A" of class "AClass" has not been completed. An interfaced method must be implemented.}

Test 3.1 {
   # Class attributes initialisation, read test

   otclInterface AClass {
      classMethod getValues {}
      classMethod modifyValues {}
   }
   otclImplementation AClass {

      classMethod getValues {} {
         list $att1 $att2 $att3 $att4 $att5(key1) $att5(key2)
      }

      classMethod modifyValues {} {
         set att1 1
         set att2 Goodbye
         set att3 "Goodbye Tester"
         set att4 {words of list a}
         set att5(key1) 5
         set att5(key2) 6
      }

      classAttribute att1 0
      classAttribute att2 Hello
      classAttribute att3 "Hello Tester"
      classAttribute att4 {a list of words}
      classAttribute att5() {{key1 value1} {key2 value2}}
   }

   AClass getValues
} 0 {0 Hello {Hello Tester} {a list of words} value1 value2} -dontclean

Test 3.2 {
   # Class attribute write test
   AClass modifyValues
   AClass getValues
} 0 {1 Goodbye {Goodbye Tester} {words of list a} 5 6} -dontclean

Test 4.1 {
   # Unknown class in class method invocation
   blah doMethod
} 1 {invalid command name "blah"}

Test 4.2 {
   # Unknown class in class method invocation
   otclInterface AClass {
   }
   AClass doMethod
} 1 {invalid command name "AClass"}

Test 4.3 {
   # Unknown method in class method invocation
   otclInterface AClass {
   }
   otclImplementation AClass {
   }
   AClass unknownMethod
} 1 {Class method "unknownMethod" not found for class "AClass".} -dontclean

Test 4.4 {
   # Not enough args for class method invocation
   AClass
} 1 {wrong # args: should be "class method ?arg...?"}


Test 5.1 {
   # Not enough argument for method
   otclInterface AClass {
     classMethod m1 {a}
   }
   otclImplementation AClass {
      classMethod m1 {a} {
         return "AClass::m1 called with a = $a"
      }
   }
   AClass m1
} 1 {Formal argument "a" has no default value but not enough actual aguments.} -dontclean

Test 5.2 {
   # Too many arguments for method
   AClass m1 a b
} 1 {Too many arguments have been supplied to "AClass::m1".} -dontclean

Test 5.3 {
   # Correct number of arguments
   list [AClass m1 Hello] [AClass m1 5] [AClass m1 [expr 5 * 66]]
} 0 {{AClass::m1 called with a = Hello} {AClass::m1 called with a = 5} {AClass::m1 called with a = 330}}

Test 5.4 {
   # Test default parameters
   otclInterface AClass {
      classMethod m1 {a {b 15}}
   }
   otclImplementation AClass {
      classMethod m1 {a b} {
         return "AClass::m1 called with a = $a, b = $b"
      }
   }
   AClass m1 10
} 0 {AClass::m1 called with a = 10, b = 15} -dontclean

Test 5.5 {
   # Test default override
   AClass m1 10 12
} 0 {AClass::m1 called with a = 10, b = 12}

Test 5.6 {
   # Test trailing 'args' empty
   otclInterface AClass {
      classMethod m1 {a args}
   }
   otclImplementation AClass {
      classMethod m1 {a args} {
         list $a $args
      }
   }
   AClass m1 5
} 0 {5 {}} -dontclean

Test 5.7 {
   # Test trailing 'args' with 1 value
   AClass m1 5 6
} 0 {5 6} -dontclean

Test 5.8 {
   # Test trailing 'args' with a list of values
   AClass m1 5 6 7 8 {Hello People} My Name Is Fred
} 0 {5 {6 7 8 {Hello People} My Name Is Fred}}

Test 6.1 {
   # Test initialisation and reading of instance attributes
   set results {}

   otclInterface AClass {
      constructor {}
      method getValues {}
      method modifyValues {}
   }
   otclImplementation AClass {

      constructor {} {} {
         global results
         lappend results [$this getValues]
      }

      method getValues {} {
         list $att0 $att1 $att2 $att3 $att4 $att5(key1) $att5(key2)
      }

      method modifyValues {} {
         set att0 0
         set att1 1
         set att2 Goodbye
         set att3 "Goodbye Tester"
         set att4 {words of list a}
         set att5(key1) 5
         set att5(key2) 6
      }

      attribute att0
      attribute att1 0
      attribute att2 Hello
      attribute att3 "Hello Tester"
      attribute att4 {a list of words}
      attribute att5() {{key1 value1} {key2 value2}}
   }

   set a [otclNew AClass]
   otclDelete $a

   set results
} 0 {{{} 0 Hello {Hello Tester} {a list of words} value1 value2}} -dontclean

Test 6.2 {
   # Test writing of instance attributes
   set results {}

   set a [otclNew AClass]
   $a modifyValues
   lappend results [$a getValues]
   otclDelete $a

   set results
} 0 {{{} 0 Hello {Hello Tester} {a list of words} value1 value2} {0 1 Goodbye {Goodbye Tester} {words of list a} 5 6}}  -dontclean

Test 6.3 {
   # Test independence of instance attributes
   set results {}

   set a [otclNew AClass]
   $a modifyValues

   set b [otclNew AClass]
   lappend results [$a getValues]
   lappend results [$b getValues]
   otclDelete $a
   otclDelete $b

   set results
} 0 {{{} 0 Hello {Hello Tester} {a list of words} value1 value2} {{} 0 Hello {Hello Tester} {a list of words} value1 value2} {0 1 Goodbye {Goodbye Tester} {words of list a} 5 6} {{} 0 Hello {Hello Tester} {a list of words} value1 value2}}

Test 7.1 {
   # Test constructor execution
   set results {}

   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {} {} {
          global results
          set results {AClass::constructor called}
      }
   }
   otclDelete [otclNew AClass]
   set results
} 0 {AClass::constructor called}

Test 7.2 {
   # Test constructor ordering for multiple inheritance
   set results {}

   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {} {} {
          global results
          lappend results "AClass::constructor called"
      }
   }
   otclInterface BClass {
      constructor {}
   }
   otclImplementation BClass {
      constructor {} {} {
         global results
         lappend results "BClass::constructor called"
      }
   }
   otclInterface CClass -isA {AClass BClass} {
      constructor {}
   }
   otclImplementation CClass {
      constructor {} {} {
         global results
         lappend results "CClass::constructor called"
      }
   }
   otclDelete [otclNew CClass]
   set results
} 0 {{AClass::constructor called} {BClass::constructor called} {CClass::constructor called}}

Test 7.3 {
   # Test passing arguments to parent constructor
   set results {}

   otclInterface AClass {
      constructor {a {b 0}}
   }
   otclImplementation AClass {
      constructor {a b} {} {
        global results
        lappend results "AClass::constructor called with a = $a, b = $b"
      }
   }
   otclInterface BClass {
      constructor {{a 5}}
   }
   otclImplementation BClass {
      constructor {a} {} {
         lappend results "BClass::constructor called with a = $a"
      }
   }
   otclInterface CClass -isA {AClass BClass} {
      constructor {a b}
   }
   otclImplementation CClass {
      constructor {a b} {{AClass [expr $a * $b]}} {
         lappend results "CClass::constructor called with a = $a, b = $b"
      }
   }
   otclDelete [otclNew CClass 10 20]
   set results
} 0 {{AClass::constructor called with a = 200, b = 0}}

Test 8.1 {
   # Test destructor calling
   set results {}

   otclInterface AClass {}
   otclImplementation AClass {
      destructor {
          global results
          lappend results "AClass::destructor called"
      }
   }
   set a [otclNew AClass]
   lappend results "About to destroy AClass instance"
   otclDelete $a
   set results
} 0 {{About to destroy AClass instance} {AClass::destructor called}}

Test 8.2 {
   # Test destructor ordering in multiple inheritance
   set results {}

   otclInterface AClass {}
   otclImplementation AClass {
      destructor {
         global results
         lappend results "AClass::destructor called"
      }
   }
   otclInterface BClass {}
   otclImplementation BClass {
      destructor {
         global results
         lappend results "BClass::destructor called"
      }
   }
   otclInterface CClass -isA {AClass BClass} {}
   otclImplementation CClass {
      destructor {
         global results
         lappend results "CClass::destructor called"
      }
   }
   set a [otclNew CClass]
   otclDelete $a

   set results
} 0 {{CClass::destructor called} {BClass::destructor called} {AClass::destructor called}}

Test 9.1 {
   # Test instance method invocation
   set results {}

   otclInterface AClass {
      method m1 {}
   }
   otclImplementation AClass {
      method m1 {} {
         global results
         lappend results "AClass::m1 called"
      }
   }
   set a [otclNew AClass]
   $a m1
   otclDelete $a

   set results
} 0 {{AClass::m1 called}} -dontclean

Test 9.3 {
   # Test instance method not known

   set a [otclNew AClass]
   $a m2
} 1 {Instance method "m2" not found for object of class "AClass".}

catch {otclDelete $a}

Test 10.1 {
   # Test private instance method access
   otclInterface AClass {
      method m1 {}
   }
   otclImplementation AClass {
      method m1 {} {
         $this m2
      }
      method m2 {} {
         return "AClass::m2 called"
      }
   }
   set a [otclNew AClass]
   $a m2
} 1 {Method "m2" of class "AClass" is private and cannot be accessed from outside class scope.} -dontclean
catch {otclDelete $a}

Test 10.2 {
   # Test private instance access
   set a [otclNew AClass]
   set results [$a m1]
   otclDelete $a

   set results
} 0 {AClass::m2 called}

Test 11.1 {
   # Test private class method access
   otclInterface AClass {
      classMethod m1 {}
   }
   otclImplementation AClass {
      classMethod m1 {} {
         AClass m2
      }
      classMethod m2 {} {
         return "AClass::m2 called"
      }
   }
   AClass m2
} 1 {Method "m2" of class "AClass" is private and cannot be accessed from outside class scope.} -dontclean

Test 11.2 {
   # Test private class method access
   AClass m1
} 0 {AClass::m2 called}

Test 12.1 {
   # Test invocation of inherit method from outside
   otclInterface AClass {
      method m1 {}
   }
   otclImplementation AClass {
     method m1 {} {
         return "AClass::m1 called"
     }
   }
   otclInterface BClass -isA AClass {
      method m2 {}
   }
   otclImplementation BClass {
      method m2 {} {
         $this m1
      }
   }
   set a [otclNew BClass]
   set results [$a m1]
   otclDelete $a
   set results
} 0 {AClass::m1 called} -dontclean

Test 12.2 {
   # Test invocation of inherited method from insidde
   set a [otclNew BClass]
   set results [$a m2]
   otclDelete $a

   set results
} 0 {AClass::m1 called} -dontclean

Test 12.3 {
   # Tes invocation of method inherited in both parent from outside
   otclInterface CClass {
      method m1 {}
   }
   otclImplementation CClass {
      method m1 {} {
         return "CClass::m1 called"
      }
   }
   otclInterface DClass -isA {AClass CClass} {
      method m3 {}
      method m4 {}
   }
   otclImplementation DClass {
      method m3 {} {
         $this m1
      }
      method m4 {} {
         # Force it to take the CClass version
         $this -CClass m1
      }
   }
   set a [otclNew DClass]
   set results [$a m1]
   otclDelete $a

   set results
} 0 {AClass::m1 called} -dontclean

Test 12.4 {
   # Test invocation of method inherited in both parents from inside
   set results {}

   set a [otclNew DClass]
   lappend results [$a m3]
   lappend results [$a m4]
   otclDelete $a

   set results
} 0 {{AClass::m1 called} {CClass::m1 called}}

Test 13.1 {
   # Test dynamic binding of method with single inheritance
   set results {}

   otclInterface AClass {
      method m1 {}
   }
   otclImplementation AClass {
      method m1 {} {
         global results
         lappend results "AClass::m1 called"
      }
   }
   otclInterface BClass -isA AClass {
      method m1 {}
   }
   otclImplementation BClass {
      method m1 {} {
         return "BClass::m1 called"
      }
   }
   set a [otclNew BClass]
   set results [$a m1]
   otclDelete $a

   set results
} 0 {BClass::m1 called} -dontclean

Test 13.2 {
   # Test dynamic binding of method with multiple inheritance
   set results {}


   otclInterface CClass {
     method m1 {}
   }
   otclImplementation CClass {
      method m1 {} {
         global results
         lappend results "CClass::m1 called"
      }
   }
   otclInterface DClass -isA {BClass CClass} {
     method m1 {}
     method m2 {}
   }
   otclImplementation DClass {
      method m1 {} {
         global results
         lappend results "DClass::m1 called"
      }
      method m2 {} {
         $this -CClass m1
      }
   }

   set a [otclNew DClass]
   $a m1
   otclDelete $a

   set results
} 0 {{DClass::m1 called}} -dontclean

Test 13.3 {
   # Test dynamic binding override
   set results {}

   set a [otclNew DClass]
   $a m2
   otclDelete $a

   set results
} 0 {{CClass::m1 called}} -dontclean

Test 13.4 {
   # Test dynamic bind override for a not base class
   otclInterface EClass -isA DClass {
      method m1 {}
   }
   otclImplementation EClass {
      method m1 {} {
         $this -FClass m1
      }
   }

   set a [otclNew EClass]
   $a m1
} 1 {Class "FClass" is not a superclass of class "EClass".}
catch {otclDelete $a}

Test 14.1 {
   # Test Unknown Instance Method
   otclInterface AClass {}
   otclImplementation AClass {}
   set a [otclNew AClass]
   $a m1
   otclDelete $a
} 1 {Instance method "m1" not found for object of class "AClass".}

Test 15.1 {
   # Not enough args for otclNew
   otclNew
} 1 {wrong # args: should be "otclNew className args"}

Test 15.2 {
   # Unknown class for otclNew
   otclNew AClass
} 1 {Class "AClass" is undefined.}

Test 16.1 {
   # Not enough arguments for otclDelete
   otclDelete
} 1 {wrong # args: should be "otclDelete object"}

Test 16.2 {
   # Bad object for otclDelete
   otclDelete 123bE
} 1 {Object (123bE) unknown.}

Test 17.1 {
   # Syntax error in constructor body no inheritance
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {} {} {
         some rubbish
      }
   }

   set a [otclNew AClass]
   otclDelete $a
} 1 {invalid command name "some"} -dontclean

Test 17.2 {
   # Syntax error in constructor body with inheritance
   otclInterface BClass -isA AClass {
   }
   otclImplementation BClass {
   }

   set a [otclNew BClass]
   otclDelete $a
} 1 {invalid command name "some"}

Test 17.3 {
   # Syntax error in class method
   otclInterface AClass {
      classMethod m1 {}
   }
   otclImplementation AClass {
      classMethod m1 {} {
         some rubbish
      }
   }
   AClass m1
} 1 {invalid command name "some"}

Test 17.4 {
   # Syntax error in instance method
   otclInterface AClass {
      method m1 {}
   }
   otclImplementation AClass {
      method m1 {} {
         some rubbish
      }
   }
   set a [otclNew AClass]
   $a m1
   otclDelete $a
} 1 {invalid command name "some"}

Test 17.5 {
   # Syntax error in destructor, no inheritance
   otclInterface AClass {
   }
   otclImplementation AClass {
      destructor {
         some rubbish
      }
   }
   set a [otclNew AClass]
   otclDelete $a
} 1 {invalid command name "some"} -dontclean

Test 17.6 {
   # Syntax error in destructor, inheritance
   otclInterface BClass -isA AClass {
   }
   otclImplementation BClass {
   }
   set a [otclNew AClass]
   otclDelete $a
} 1 {invalid command name "some"} -dontclean

Test 17.7 {
   # Syntax error in parent constructor
   otclInterface CClass -isA BClass {
      constructor {a}
   }
   otclImplementation CClass {
      constructor {a} {{BClass [expr $a + $b]}} {
      }
   }
   set a [otclNew CClass 55]
} 1 {can't read "b": no such variable}

Test 18.1 {
   # constructor duplicate in interface
   otclInterface AClass {
      constructor {}
      constructor {}
   }
} 1 {Method "constructor" duplicated in interface for class "AClass".}

Test 18.2 {
   # constructor duplicate in implementation
   otclInterface AClass {
      constructor {}
   }
   otclImplementation AClass {
      constructor {} {} {}
      constructor {} {} {}
   }
} 1 {Method "AClass::constructor" implementated twice.}

Test 18.3 {
   # destructor duplicated in implementation
   otclInterface AClass {}
   otclImplementation AClass {
      destructor {}
      destructor {}
   }
} 1 {Re-definition of destructor in class "AClass".}

Test 19.1 {
   # Constructor arg same as inst attribute
   otclInterface AClass {
      constructor {a}
   }
   otclImplementation AClass {
      constructor {a} {} {}
      attribute a
   }
} 1 {Method "constructor" of class "AClass" has a formal argument "a" that classes with an attribute of the same name.}

Test 19.2 {
   # Constructor arg same as class attribute
   otclInterface AClass {
      constructor {a}
   }
   otclImplementation AClass {
      constructor {a} {} {}
      classAttribute a 0
   }
} 1 {Method "constructor" of class "AClass" has a formal argument "a" that classes with an attribute of the same name.}

Test 19.3 {
   # Instance method arg same as inst attribute
   otclInterface AClass {
      method a {b}
   }
   otclImplementation AClass {
      method a {b} {}
      attribute b
   }
} 1 {Method "a" of class "AClass" has a formal argument "b" that classes with an attribute of the same name.}

Test 19.4 {
   # Instance method arg same as class attribute
   otclInterface AClass {
      method a {b}
   }
   otclImplementation AClass {
      method a {b} {}
      classAttribute b 0
   }
} 1 {Method "a" of class "AClass" has a formal argument "b" that classes with an attribute of the same name.}

Test 19.5 {
   # Class method arg same as instance attribute
   otclInterface AClass {
      classMethod a {b}
   }
   otclImplementation AClass {
      classMethod a {b} {}
      attribute b
   }
} 0 {}

Test 19.6 {
   # Class method arg same as class attribute
   otclInterface AClass {
      classMethod a {b}
   }
   otclImplementation AClass {
      classMethod a {b} {}
      classAttribute b 0
   }
} 1 {Method "a" of class "AClass" has a formal argument "b" that classes with an attribute of the same name.}

Test 20.1 {
   set results {}

   # Test unknown method
   otclInterface AClass {
      method unknown {args}
   }
   otclImplementation AClass {
      method unknown {args} {
         global results
         set results [list unknown $args]
      }
   }

   set o [otclNew AClass]
   $o notARealMethod 55 66 77
   otclDelete $o

   set results
} 0 {unknown {notARealMethod 55 66 77}} -dontclean

Test 20.2 {
   # Test unknown method is inherited
   set results {}

   otclInterface BClass -isA AClass {
   }
   otclImplementation BClass {}

   set o [otclNew BClass]
   $o notARealMethod 77 66 55
   otclDelete $o

   set results
} 0 {unknown {notARealMethod 77 66 55}}

Test 21.1 {
   # Test manipulation of a C++ class, object
   set results {}

   lappend results [SimpleCppClass getNoOfObjects]
   set a [otclNew SimpleCppClass "Hello" 55]
   lappend results [SimpleCppClass getNoOfObjects]
   lappend results [$a getValue]
   lappend results [$a getStr]
   $a setValue 12
   $a setStr "Goodbye"
   lappend results [$a getValue]
   lappend results [$a getStr]
   set b [otclNew SimpleCppClass "Bob" 99]
   otclDelete $a
   otclDelete $b

   set results
} 0 {0 {SimpleCppClass constructed} 1 55 Hello 12 Goodbye {SimpleCppClass constructed} {SimpleCppClass destructed} {SimpleCppClass destructed}}

Test 21.2 {
   # Test inheritance from C++ class
   set results {}

   otclInterface AClass -isA SimpleCppClass {
      constructor {str val}
   }
   otclImplementation AClass {
      constructor {str val} {{SimpleCppClass $str $val}} {
         lappend results "AClass constructed"
      }
      destructor {
         lappend results "AClass destructed"
      }
   }
   lappend results [SimpleCppClass getNoOfObjects]
   set a [otclNew AClass "Hello" 55]
   lappend results [SimpleCppClass getNoOfObjects]
   lappend results [$a getValue]
   lappend results [$a getStr]
   $a setValue 12
   $a setStr "Goodbye"
   lappend results [$a getValue]
   lappend results [$a getStr]
   otclDelete $a

   set results
} 0 {0 {SimpleCppClass constructed} 1 55 Hello 12 Goodbye {SimpleCppClass destructed}}

Test 21.3 {
   # Test dynamic binding of methods from C++.
   set results {}

   otclInterface AClass -isA TestCppClass {
      constructor {{val 0}}
      method methodTwo {}
   }
   otclImplementation AClass {
      constructor {v} {} {
         set val $v
      }
      method methodTwo {} {
         global results
         lappend results "AClass::methodTwo called, val = $val"
      }
      attribute val
   }
   set a [otclNew AClass]
   $a methodOne
   otclDelete $a

   set results
} 0 {{AClass::methodTwo called, val = 0}} -dontclean

Test 21.4 {
   # Test C++ manipulation of Object Tcl object
   set results {}

   set a [otclNew AClass]
   set b [otclNew AClass 99]
   $a setOtherObject $b
   if {[$a getOtherObject] != $b} {
      lappend results "object returned is different to object given"
   }
   $a doMethodTwoOnOtherObject
   otclDelete $a
   otclDelete $b

   set results
} 0 {{AClass::methodTwo called, val = 99}}

Test 22.1 {
   # Test this available from constructor
   set results {}

   otclInterface AClass {
      constructor {}
      method methodOne {}
   }
   otclImplementation AClass {
      constructor {} {} {
         $this methodOne
      }
      method methodOne {} {
         global results
         lappend results "AClass::methodOne called"
      }
   }
   otclNew AClass

   set results
} 0 {{AClass::methodOne called}} -dontclean

Test 22.2 {
   # Test this available from constructor of superclass part
   set results {}

   otclInterface BClass -isA AClass {
      constructor {}
      method methodTwo {}
   }
   otclImplementation BClass {
      constructor {} {} {
         $this methodTwo
      }
      method methodTwo {} {
         global results
         lappend results "BClass::methodTwo called"
      }
   }
   otclNew BClass

   set results
} 0 {{AClass::methodOne called} {BClass::methodTwo called}}

Test 23.1 {
   # Test global commands are available
   set results {}

   proc constructor {} {global results; lappend results "constructor"}
   proc destructor {} {global results; lappend results "destructor"}
   proc method {} {global results; lappend results "method"}
   proc classMethod {} {global results; lappend results "classMethod"}
   proc attribute {} {global results; lappend results "attribute"}
   proc classAttribute {} {global results; lappend results "classAttribute"}

   constructor
   destructor
   method
   classMethod
   attribute
   classAttribute

   otclInterface AClass {}

   constructor
   destructor
   method
   classMethod
   attribute
   classAttribute

   otclImplementation AClass {}

   constructor
   destructor
   method
   classMethod
   attribute
   classAttribute

   set results

} 0 {constructor destructor method classMethod attribute classAttribute constructor destructor method classMethod attribute classAttribute constructor destructor method classMethod attribute classAttribute}

Test 24.1 {
   set results {}
   set a [otclNew PtrTestClass NULL]
   otclDelete $a
   set a [otclNew PtrTestClass null]
   otclDelete $a
   set a [otclNew PtrTestClass 0]
   set b [otclNew PtrTestClass $a]
   otclDelete $b

   PtrTestClass classMethodTest NULL
   PtrTestClass classMethodTest null
   PtrTestClass classMethodTest 0
   PtrTestClass classMethodTest $a

   $a instanceMethodTest NULL
   $a instanceMethodTest null
   $a instanceMethodTest 0
   $a instanceMethodTest $a

   otclDelete $a

   set results
} 0 {{passed ptr == NULL} {passed ptr == NULL} {passed ptr == NULL} {passed ptr != NULL} {passed ptr == NULL} {passed ptr == NULL} {passed ptr == NULL} {passed ptr != NULL} {passed ptr == NULL} {passed ptr == NULL} {passed ptr == NULL} {passed ptr != NULL}}

Test 24.2 {
   set results {}

   set a [otclNew PtrTestClass invalid]

   set results
} 1 {Argument 0 invalid}

Test 24.3 {
   set results {}

   PtrTestClass classMethodTest invalid

   set results
} 1 {Argument 0 invalid.}

Test 24.4 {

   set a [otclNew PtrTestClass NULL]
   $a instanceMethodTest invalid

} 1 {Argument 0 invalid.}