fix com, prettyprinting of GUIDs

diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor
index 59a76bf4d7df97a763d6f22af27a063eae6f4a0f..56ae0aa71c6e66a996345b9e42a56ab5d8712b8a 100755 (executable)
--- a/basis/windows/com/syntax/syntax.factor
+++ b/basis/windows/com/syntax/syntax.factor
@@ -1,7 +1,8 @@
 USING: alien alien.c-types alien.accessors effects kernel
 windows.ole32 parser lexer splitting grouping sequences
 namespaces assocs quotations generalizations accessors words
-macros alien.syntax fry arrays layouts math ;
+macros alien.syntax fry arrays layouts math classes.struct
+windows.kernel32 prettyprint.custom prettyprint.sections ;
 IN: windows.com.syntax
 
 <PRIVATE
@@ -100,3 +101,5 @@ SYNTAX: COM-INTERFACE:
     define-words-for-com-interface ;
 
 SYNTAX: GUID: scan string>guid parsed ;
+
+M: GUID pprint* guid>string "GUID: " prepend text ;

diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index afa3abf287937399a921e52e141b094572ce7641..3d78ccc849f632c4ff50f8b0ee8e4e8b4d09a1cc 100755 (executable)
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -48,7 +48,7 @@ unless
 : (make-query-interface) ( interfaces -- quot )
     (query-interface-cases) 
     '[
-        swap 16 memory>byte-array
+        swap GUID memory>struct
         _ case
         [
             "void*" heap-size * rot <displaced-alien> com-add-ref

diff --git a/basis/windows/ole32/ole32-tests.factor b/basis/windows/ole32/ole32-tests.factor
index ecd25738b1569516ff3f296fc7a1e928f283d3c0..aa02211ef3b426d03ae6fe170e58aca2c6ffee72 100644 (file)
--- a/basis/windows/ole32/ole32-tests.factor
+++ b/basis/windows/ole32/ole32-tests.factor
@@ -1,4 +1,5 @@
-USING: kernel tools.test windows.ole32 alien.c-types ;
+USING: kernel tools.test windows.ole32 alien.c-types
+classes.struct specialized-arrays.uchar windows.kernel32 ;
 IN: windows.ole32.tests
 
 [ t ] [
@@ -19,17 +20,9 @@ IN: windows.ole32.tests
     guid=
 ] unit-test
         
-little-endian?
-[ B{
-    HEX: 67 HEX: 45 HEX: 23 HEX: 01 HEX: ab HEX: 89 HEX: ef HEX: cd
-    HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ]
-[ B{
-    HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-    HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ] ?
-[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ]
-unit-test
+[
+    GUID: 01234567-89ab-cdef-0123-456789abcdef}
+] [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ] unit-test
 
 [ "{01234567-89ab-cdef-0123-456789abcdef}" ]
 [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]

diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index 37a3a90d3b4e0995a70358b74208bdffef28fb36..0942123504116a86576ac414a74f90e654c161a6 100755 (executable)
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -143,9 +143,9 @@ CONSTANT: GUID-STRING-LENGTH
 : guid>string ( guid -- string )
     [
         [ "{" ] dip {
-            [ Data1>> >hex "-" ]
-            [ Data2>> >hex "-" ]
-            [ Data3>> >hex "-" ]
+            [ Data1>> >hex 8 CHAR: 0 pad-head "-" ]
+            [ Data2>> >hex 4 CHAR: 0 pad-head "-" ]
+            [ Data3>> >hex 4 CHAR: 0 pad-head "-" ]
             [
                 Data4>> [
                     {