Closes fpco#30

spencerjanssen · Feb 23, 2021 · 7c0cea4 · 7c0cea4
1 parent 635d8b6
commit 7c0cea4
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 11 deletions.
diff --git a/src/Database/ODBC/Internal.hs b/src/Database/ODBC/Internal.hs
@@ -679,16 +679,21 @@ getGuid :: Ptr EnvAndDbc -> SQLHSTMT s -> SQLUSMALLINT -> IO Value
 getGuid dbc stmt column = do
   uninterruptibleMask_
     (do bufferp <- callocBytes odbcGuidBytes
-        void
-          (getTypedData
-             dbc
-             stmt
-             sql_c_binary
-             column
-             (coerce bufferp)
-             (SQLLEN odbcGuidBytes))
-        !bs <- S.unsafePackMallocCStringLen (bufferp, odbcGuidBytes)
-        evaluate (BinaryValue (Binary bs)))
+        copiedBytes <-
+          getTypedData
+            dbc
+            stmt
+            sql_c_binary
+            column
+            (coerce bufferp)
+            (SQLLEN odbcGuidBytes)
+        case copiedBytes of
+          Nothing -> do
+            free bufferp
+            pure NullValue
+          Just {} -> do
+            !bs <- S.unsafePackMallocCStringLen (bufferp, odbcGuidBytes)
+            evaluate (BinaryValue (Binary bs)))
 
 -- | Get the column's data as a vector of CHAR.
 getBytesData :: Ptr EnvAndDbc -> SQLHSTMT s -> SQLUSMALLINT -> IO Value

diff --git a/test/Main.hs b/test/Main.hs
@@ -162,7 +162,7 @@ conversionTo = do
   quickCheckRoundtrip @ByteString "ByteString" ("varchar(" <>  (show maxStringLen) <> ")")
   quickCheckRoundtrip @TestBinary "ByteString" ("binary(" <>  (show maxStringLen) <> ")")
   quickCheckRoundtrip @Binary "ByteString" ("varbinary(" <>  (show maxStringLen) <> ")")
-  quickCheckRoundtripEx @TestGUID False "GUID" "uniqueidentifier"
+  quickCheckRoundtrip @TestGUID "GUID" "uniqueidentifier" -- Regression tests against https://github.com/fpco/odbc/issues/30
 
 connectivity :: Spec
 connectivity = do