[hoc-cvs] hoc/Tests TestFoundation.hs,1.3,1.4

[Wolfgang T. <wth...@us...>]

Update of /cvsroot/hoc/hoc/Tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9095/Tests

Modified Files:
	TestFoundation.hs 
Log Message:
Implement sending messages to super.
Objective-C: [super foo];
Haskell:     super self # foo


Index: TestFoundation.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Tests/TestFoundation.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- TestFoundation.hs	31 Mar 2005 20:52:43 -0000	1.3
+++ TestFoundation.hs	25 Jul 2005 03:59:26 -0000	1.4
@@ -43,6 +43,18 @@
         Outlet "otherObject" [t| ID () |]
     ])
 
+
+$(declareClass "HaskellObjectWithDescription" "NSObject")
+
+$(exportClass "HaskellObjectWithDescription" "ho2_" [
+		InstanceMethod info_description
+    ])
+
+ho2_description self
+	= do
+		superDesc <- fmap fromNSString $ super self # description
+		return $ toNSString $ head (words superDesc) ++ " TEST>"
+
 tests = test [
         "NSNumber" ~: test [
             "alloc-initWithInt-intValue" ~: (assertNoLeaks $ do
@@ -142,11 +154,17 @@
                 expected <- try (fail "Message sent to nil: intValue")
                 result @?= expected
             )            
-        ]
+        ],
+        "Description" ~: (assertNoLeaks $ do
+        	hobj <- _HaskellObjectWithDescription # alloc >>= init
+        	str <- hobj # description
+        	fromNSString str @?= "<HaskellObjectWithDescription: TEST>"
+        )
     ]
 
 go = withAutoreleasePool $ runTestTT tests
 
 main = do
     initializeClass_HaskellObjectWithOutlet
+    initializeClass_HaskellObjectWithDescription
     go