Fix truncation with unparse-string

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

diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor
index 43e99d739a327be46d038500e234d4bde4cbe0d5..adfbb832b28ae4e007b41872329198fed47697db 100644 (file)
--- a/basis/windows/com/com-tests.factor
+++ b/basis/windows/com/com-tests.factor
@@ -41,67 +41,68 @@ 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 <ref> long deref 1array [ +guinea-pig-implementation+ get ISimple::returnError ] unit-test
-            20 1array [
+    [
+        {
+            { 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 <ref> long deref 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
-                [ 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
+                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
+] with-destructors
 
 ! Ensure that we freed +guinea-pig-implementation
 +orig-wrapped-objects+ get-global 1array [ +wrapped-objects+ get-global ] unit-test