Various Windows load fixes

[factor.git] / basis / windows / com / com-tests.factor

diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor
old mode 100644 (file)
new mode 100755 (executable)
index 25e3082..329a84e
--- a/basis/windows/com/com-tests.factor
+++ b/basis/windows/com/com-tests.factor
@@ -1,7 +1,7 @@
 USING: kernel windows.com windows.com.syntax windows.ole32
-alien alien.syntax tools.test libc alien.c-types 
+alien alien.syntax tools.test libc alien.c-types
 namespaces arrays continuations accessors math windows.com.wrapper
-windows.com.wrapper.private destructors effects ;
+windows.com.wrapper.private destructors effects compiler.units ;
 IN: windows.com.tests
 
 COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
@@ -34,68 +34,70 @@ SYMBOL: +orig-wrapped-objects+
 +wrapped-objects+ get-global clone +orig-wrapped-objects+ set-global
 
 TUPLE: test-implementation x ;
-C: <test-implementation> test-implementation 
-
-{
-    { IInherited {
-        [ drop S_OK ] ! ISimple::returnOK
-        [ drop E_FAIL ] ! ISimple::returnError
-        [ x>> ] ! IInherited::getX
-        [ >>x drop ] ! IInherited::setX
-    } }
-    { IUnrelated {
-        [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
-        [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
-    } }
-} <com-wrapper>
-dup +test-wrapper+ set [
-
-    0 <test-implementation> swap com-wrap
-    dup +guinea-pig-implementation+ set [ drop
-
-        S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
-        E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
-        20 1array [
-            +guinea-pig-implementation+ get
-            [ 20 IInherited::setX ]
-            [ IInherited::getX ] bi
-        ] unit-test
-        420 1array [
-            +guinea-pig-implementation+ get
-            IUnrelated-iid com-query-interface
-            [ 20 20 IUnrelated::xMulAdd ] with-com-interface
-        ] unit-test
-        40 1array [
-            +guinea-pig-implementation+ get
-            IUnrelated-iid com-query-interface
-            [ 20 IUnrelated::xPlus ] with-com-interface
-        ] unit-test
-
-        +guinea-pig-implementation+ get 1array [
-            +guinea-pig-implementation+ get com-add-ref
-        ] unit-test
-
-        { } [ +guinea-pig-implementation+ get com-release ] unit-test
-
-        +guinea-pig-implementation+ get 1array [
-            +guinea-pig-implementation+ get IUnknown-iid com-query-interface
-            dup com-release
-        ] unit-test
-        +guinea-pig-implementation+ get 1array [
-            +guinea-pig-implementation+ get ISimple-iid com-query-interface
-            dup com-release
-        ] unit-test
-        void* heap-size +guinea-pig-implementation+ get <displaced-alien>
-        +guinea-pig-implementation+ get
-        2array [
-            +guinea-pig-implementation+ get IUnrelated-iid com-query-interface
-            dup ISimple-iid com-query-interface
-            over com-release dup com-release
-        ] unit-test
-
-    ] with-com-interface
-
-] with-disposal
+C: <test-implementation> test-implementation
+
+[
+    {
+        { IInherited {
+            [ drop S_OK ] ! ISimple::returnOK
+            [ drop E_FAIL ] ! ISimple::returnError
+            [ x>> ] ! IInherited::getX
+            [ >>x drop ] ! IInherited::setX
+        } }
+        { IUnrelated {
+            [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
+            [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
+        } }
+    } <com-wrapper>
+    dup +test-wrapper+ set [
+
+        0 <test-implementation> swap com-wrap
+        dup +guinea-pig-implementation+ set [ drop
+
+            S_OK 1array [ +guinea-pig-implementation+ get ISimple::returnOK ] unit-test
+            E_FAIL <long> *long 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
+            20 1array [
+                +guinea-pig-implementation+ get
+                [ 20 IInherited::setX ]
+                [ IInherited::getX ] bi
+            ] unit-test
+            420 1array [
+                +guinea-pig-implementation+ get
+                IUnrelated-iid com-query-interface
+                [ 20 20 IUnrelated::xMulAdd ] with-com-interface
+            ] unit-test
+            40 1array [
+                +guinea-pig-implementation+ get
+                IUnrelated-iid com-query-interface
+                [ 20 IUnrelated::xPlus ] with-com-interface
+            ] unit-test
+
+            +guinea-pig-implementation+ get 1array [
+                +guinea-pig-implementation+ get com-add-ref
+            ] unit-test
+
+            { } [ +guinea-pig-implementation+ get com-release ] unit-test
+
+            +guinea-pig-implementation+ get 1array [
+                +guinea-pig-implementation+ get IUnknown-iid com-query-interface
+                dup com-release
+            ] unit-test
+            +guinea-pig-implementation+ get 1array [
+                +guinea-pig-implementation+ get ISimple-iid com-query-interface
+                dup com-release
+            ] unit-test                                              
+            void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+            +guinea-pig-implementation+ get                                           
+            2array [
+                +guinea-pig-implementation+ get IUnrelated-iid com-query-interface
+                dup ISimple-iid com-query-interface
+                over com-release dup com-release
+            ] unit-test
+
+        ] with-com-interface
+
+    ] with-disposal
+] with-compilation-unit
 
 ! Ensure that we freed +guinea-pig-implementation
 +orig-wrapped-objects+ get-global 1array [ +wrapped-objects+ get-global ] unit-test