windows: Add check-hresult function.

[factor.git] / basis / windows / ole32 / ole32.factor

diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index ac351a1f91fc9457bb36f8879e15e2208d97a3f1..b4faa6da0d2e7de5c97e0924a96b3e2ecef2384a 100644 (file)
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -36,6 +36,11 @@ CONSTANT: DRAGDROP_S_DROP 0x00040100
 CONSTANT: DRAGDROP_S_CANCEL 0x00040101
 CONSTANT: DRAGDROP_S_USEDEFAULTCURSORS 0x00040102
 
 CONSTANT: DRAGDROP_S_CANCEL 0x00040101
 CONSTANT: DRAGDROP_S_USEDEFAULTCURSORS 0x00040102
 

+ERROR: hresult-error n ;
+
+: check-hresult ( n -- )
+    dup S_OK = [ drop ] [ hresult-error ] if ;
+

 <<
 : >long ( integer -- long )
     long <ref> long deref ; inline
 <<
 : >long ( integer -- long )
     long <ref> long deref ; inline