https://github.com/jrincayc/ucblogo-code
Tip revision: 62fc2f7d6c41edcf685277a872c68e47a76fb254 authored by Dan Malec on 12 December 2020, 01:50:52 UTC
FEAT-CD: Initial pass at having a CD build.
FEAT-CD: Initial pass at having a CD build.
Tip revision: 62fc2f7
UnitTests-OOP.lg
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; BERKELEY LOGO ;;
;; OOP TEST SUITE ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
InstallSuite [OOP Tests] [Tests.OOP.Setup]
;; The list of all OOP unit tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MAKE "Tests.OOP [
Tests.OOP.Ask
Tests.OOP.Exist
Tests.OOP.Make
Tests.OOP.MakeMany
Tests.OOP.OneOf
Tests.OOP.OneOfCheckVar
Tests.OOP.OverrideExist
Tests.OOP.Parents
Tests.OOP.TalkTo
Tests.OOP.Usual
Tests.OOP.UsualChain
;; The following are strictly regression tests
Tests.OOP.ChildWontChangeParent
Tests.OOP.MemberFunctionOverride
Tests.OOP.CaseSensitiveMemberVars
Tests.OOP.OverriddenMethods
Tests.OOP.UsualInLogo
Tests.OOP.OverriddenMethods1
Tests.OOP.OverriddenMethods2
Tests.OOP.OverriddenMethods3
Tests.OOP.OverriddenMethods4
Tests.OOP.MultipleInheritanceTalker
Tests.OOP.MultipleInheritanceShouter
Tests.OOP.MultipleInheritanceWhisperer
Tests.OOP.MultipleInheritanceCombination1
Tests.OOP.MultipleInheritanceCombination2
Tests.OOP.ExistChain1
Tests.OOP.ExistChain2
Tests.OOP.DoubleDashed
Tests.OOP.DashedDouble
]
;; Test Suite setup procedure, main entry
;; point for all tests in this suite
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
to Tests.OOP.Setup
RunTests :Tests.OOP
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; HELPERS & OBJECTS ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
to ignore :value
end
make "ABase kindof logo
ask :ABase [to Exist]
have "avar
make "avar 1
end
make "ExistChild kindof logo
ask :ExistChild [to Exist]
make "avar 2
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; ADD INDIVIDUAL UNIT TESTS BELOW ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
to safecheck :obj :var :expected
make "success 0
CATCH "Error [ignore (ask thing :obj [thing :var]) make "success 1]
OUTPUT IFELSE [equal? :success 0] [equal? 0 1] [equal? (ask thing :obj [thing :var]) 1]
end
to Tests.OOP.Ask
make "bob kindof logo
make "dummy ask :bob [self]
OUTPUT EQUAL? 1 1
end
to Tests.OOP.Exist
make "bob oneof :ABase
OUTPUT EQUAL? (ASK :bob [:avar]) 1
end
to Tests.OOP.Make
make "bob kindof logo
OUTPUT Equal? 1 1
end
to Tests.OOP.MakeMany
make "loqi kindof logo
make "geetha kindof logo
make "chaidan (kindof :loqi :geetha)
OUTPUT equal? (Count ask :chaidan [parents]) 2
end
to Tests.OOP.OneOf
make "bob oneof :ABase
OUTPUT Equal? 1 1
end
to Tests.OOP.OneOfCheckVar
make "bob oneof :ABase
OUTPUT EQUAL? (ASK :bob [:avar]) 1
end
to Tests.OOP.OverrideExist
make "bob kindof :ExistChild
ask :bob [exist]
;OUTPUT safecheck "bob "avar 2
OUTPUT Equal? (ask :bob [:avar]) 2
end
to Tests.OOP.Parents
make "bob kindof logo
make "jim kindof :bob
OUTPUT AND (ask :jim [parents]) = (list :bob) (ask :bob [parents]) = (list Logo)
end
to Tests.OOP.TalkTo
make "bob kindof logo
ask :bob [have "hat]
ask :bob [make "hat "red]
talkto :bob
make "result equal? :hat "red
talkto Logo
OUTPUT :result
end
;; Syntax to test
;; Usual.Method (inside an object proc call)
;; Overriding methods (by redefining exsiting methods)
;; Exist / overriding Exist
;; Usual.Exist (inside overriden exist)
;; Make "OBj OneOf :OtherObj (a combination of KindOf and Exist)
;; Make "NewObj (OneOf :Obj "prop value) -- initialize with specific values
;; HaveMake "Name Value (have combined with make)
make "Usual1 something
ask :Usual1 [to foo]
op "True
end
Make "Usual2 kindof :Usual1
ask :Usual2 [to foo]
op usual.foo
end
make "Usual3 kindof :Usual2
ask :Usual3 [to foo]
op usual.foo
end
to Tests.OOP.Usual
OUTPUT equalp (ask :Usual2 [foo]) "True
end
to Tests.OOP.UsualChain
OUTPUT equalp (ask :Usual3 [foo]) "True
end
;; -------------------------------------------------
;; REGRESSION TESTS
;; -------------------------------------------------
;; This regression tests verifies
;; that when you change a child value
;; the parent value remains unchanged
to Tests.OOP.ChildWontChangeParent
make "bob oneof Logo
ask :bob [have "hat]
ask :bob [make "hat "blue]
make "joe oneof :bob
ask :joe [make "hat "red]
OUTPUT (ask :bob [:hat]) = (ask :joe [:hat])
end
to Tests.OOP.CaseSensitiveMemberVars
make "bob something
ask :bob [have "aVarIable]
ask :bob [make "aVarIable 1]
ask :bob [make "avariable 2]
OUTPUT equal? (ask :bob [:avariable]) 2
end
to bar
output "True
end
make "a something
ask :a [to bar]
output usual.bar
end
ask :a [to foo :x]
output :x
end
make "b kindof :a
ask :b [to foo]
OUTPUT usual.foo "True
end
to Tests.OOP.OverriddenMethods
make "c kindof :b
(ask :c [make "baz foo])
OUTPUT equal? (ask :c [:baz]) "True
end
to Tests.OOP.UsualInLogo
make "c kindof :a
OUTPUT equal? (ask :c [bar]) "True
end
;; This is setup for the next test
;; Methods are defined a different levels
;; Check that the proper method will get called
make "InheritA something
ask :InheritA [to foo]
op "fooA
end
make "InheritB kindof :InheritA
ask :InheritB [to bar]
op "barB
end
make "InheritC kindof :InheritB
ask :InheritC [to foo]
op "fooC
end
ask :InheritC [to bar]
op "barC
end
ask :InheritC [to baz1]
op se foo bar
end
ask :InheritC [to baz2]
op se foo usual.bar
end
ask :InheritC [to baz3]
op se usual.foo bar
end
ask :InheritC [to baz4]
op se usual.foo usual.bar
end
to Tests.OOP.OverriddenMethods1
OUTPUT equal? (ask :InheritC [baz1]) [fooC barC]
end
to Tests.OOP.OverriddenMethods2
OUTPUT equal? (ask :InheritC [baz2]) [fooC barB]
end
to Tests.OOP.OverriddenMethods3
OUTPUT equal? (ask :InheritC [baz3]) [fooA barC]
end
to Tests.OOP.OverriddenMethods4
OUTPUT equal? (ask :InheritC [baz4]) [fooA barB]
end
;;; G.Drescher: "Object-oriented Logo"
;;; in Lawler, Yazdani: "Artifical Intelligence and Education: Learning environments and tutoring systems", Intellect Books, 1987
make "talker something
ask :talker [have "name]
ask :talker [make "name "gertrude]
ask :talker [to say :msg]
op (sentence :name "says :msg)
end
ask :talker [to exist]
make "exist.chain fput "talker :exist.chain
end
;;
make "shouter kindof :talker
ask :shouter [to say :msg]
op (se "hey! usual.say :msg)
end
ask :shouter [to exist]
usual.exist
make "exist.chain fput "shouter :exist.chain
end
;;
make "whisperer kindof :talker
ask :whisperer [to say :msg]
op (se "shhh... usual.say :msg)
end
ask :whisperer [to exist]
usual.exist
make "exist.chain fput "whisperer :exist.chain
end
;;
make "combination1 (kindof :shouter :whisperer)
ask :combination1 [to exist]
usual.exist
make "exist.chain fput "combination1 :exist.chain
end
;;
make "combination2 (kindof :whisperer :shouter)
ask :combination2 [to exist]
usual.exist
make "exist.chain fput "combination2 :exist.chain
end
to Tests.OOP.MultipleInheritanceTalker
OUTPUT equal? (ask :talker [say "hi]) [gertrude says hi]
end
to Tests.OOP.MultipleInheritanceShouter
OUTPUT equal? (ask :shouter [say "hello]) [hey! gertrude says hello]
end
to Tests.OOP.MultipleInheritanceWhisperer
OUTPUT equal? (ask :whisperer [say "howdy]) [shhh... gertrude says howdy]
end
to Tests.OOP.MultipleInheritanceCombination1
OUTPUT equal? (ask :combination1 [say "howdy]) [hey! shhh... gertrude says howdy]
end
to Tests.OOP.MultipleInheritanceCombination2
OUTPUT equal? (ask :combination2 [say "hola]) [shhh... hey! gertrude says hola]
end
to Tests.OOP.ExistChain1
make "exist.chain []
ask :combination1 [exist]
OUTPUT (equal? :exist.chain
[combination1 shouter whisperer talker])
end
to Tests.OOP.ExistChain2
make "exist.chain []
ask :combination2 [exist]
OUTPUT (equal? :exist.chain
[combination2 whisperer shouter talker])
end
;; B.Harvey: canonical Object Logo example
;; 4feb2020
;;
make "turtle something
talkto :turtle
to exist
usual.exist
have (list "pos "pen "dash.count "dash.len)
make "pos 0
make "pen "down
make "dash.count 0
make "dash.len 0
end
to setpos :x
make "pos :x
end
to penup
make "pen "up
make "dash.count :dash.count + 1
end
to pendown
make "pen "down
end
to forward :dist
if :pen = "down [make "dash.len :dash.len + :dist]
setpos :pos + :dist
end
make "double.turtle kindof :turtle
talkto :double.turtle
to forward :dist
usual.forward 2*:dist
end
talkto logo
make "dashed.turtle kindof :turtle
talkto :dashed.turtle
to forward :dist
if :dist < 10 [usual.forward :dist stop]
penup
usual.forward 5
pendown
usual.forward 5
forward :dist-10
end
talkto logo
to Tests.OOP.DoubleDashed
; 20 length-5 dashes
local "turtle1
make "turtle1 oneof (list :double.turtle :dashed.turtle)
ask :turtle1 [pendown forward 100]
OUTPUT (equal? ask :turtle1 [(se :pos :pen :dash.count :dash.len)]
[200 down 20 100])
end
to Tests.OOP.DashedDouble
; 10 length-10 dashes
local "turtle2
make "turtle2 oneof (list :dashed.turtle :double.turtle)
ask :turtle2 [pendown forward 100]
OUTPUT (equal? ask :turtle2 [(se :pos :pen :dash.count :dash.len)]
[200 down 10 100])
end
;; This is setup for the next test
;; When an object has a function with the
;; same name as its parent's, the child's method
;; should be called, not the parent's method
make "MemRegr KindOf Logo
to OOP.Regr.foo
OUTPUT 1
end
ask :MemRegr [to OOP.Regr.foo]
OUTPUT 0
end
to Tests.OOP.MemberFunctionOverride
OUTPUT equal? (ASK :MemRegr [OOP.Regr.foo]) 0
end
;; TODO: Need to test the TO proc on objects
;; but logo doesn't like it when you use
;; TO inside a TO