mitigate "If an error is generated, no change is made to the contents"

Most glGet* functions don't change change the contents of the buffer
if an error is generated.  Buffers created with `alloca` have undefined
contents, which if used causes undefined behaviour (eg: allocating a
huge chunk of memory if a size is peeked, overwriting unspecified
memory if a pointer is peeked).

This patch mitigates the issue to some extent by using `with 0` and
`with nullPtr` instead of `alloca`, so at least the content of the
buffer is defined.  There are still some places unchanged, this patch
concentrates on cases where the result would be used as a size for
memory allocations or as a pointer.

The initial bug report was here:
https://www.haskell.org/pipermail/hopengl/2015-January/001152.html

Author: claudeha

src/Graphics/Rendering/OpenGL/GL/BufferObjects.hs

@@ -42,8 +42,8 @@ module Graphics.Rendering.OpenGL.GL.BufferObjects (
 ) where
 
 import Data.Maybe
-import Foreign.Marshal.Alloc
 import Foreign.Marshal.Array
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.Exception
@@ -278,15 +278,15 @@ marshalGetBufferPName x = case x of
    GetBufferMapped -> gl_BUFFER_MAPPED
 
 getBufferParameter :: BufferTarget -> (GLenum -> a) -> GetBufferPName -> IO a
-getBufferParameter t f p = alloca $ \buf -> do
+getBufferParameter t f p = with 0 $ \buf -> do
    glGetBufferParameteriv (marshalBufferTarget t)
                           (marshalGetBufferPName p) buf
    peek1 (f . fromIntegral) buf
 
 --------------------------------------------------------------------------------
 
 getBufferPointer :: BufferTarget -> IO (Ptr a)
-getBufferPointer t = alloca $ \buf -> do
+getBufferPointer t = with nullPtr $ \buf -> do
    glGetBufferPointerv (marshalBufferTarget t) gl_BUFFER_MAP_POINTER buf
    peek buf
 

src/Graphics/Rendering/OpenGL/GL/Evaluators.hs

@@ -47,8 +47,8 @@ module Graphics.Rendering.OpenGL.GL.Evaluators (
 import Control.Monad
 import Data.List
 import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc
 import Foreign.Marshal.Array
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.Capability
@@ -198,7 +198,7 @@ getMap1 dummyControlPoint = do
    domain <- allocaArray 2 $ \ptr -> do
       glGetMapv target (marshalGetMapQuery Domain) ptr
       peek2 (,) ptr
-   order <- alloca $ \ptr -> do
+   order <- with 0 $ \ptr -> do
       glGetMapiv target (marshalGetMapQuery Order) ptr
       fmap fromIntegral $ peek ptr
    withNewMap1 (MapDescriptor domain (numComponents dummyControlPoint) order numComp) $
@@ -297,7 +297,7 @@ getMap2 dummyControlPoint = do
    (uDomain, vDomain) <- allocaArray 4 $ \ptr -> do
       glGetMapv target (marshalGetMapQuery Domain) ptr
       peek4 (\u1 u2 v1 v2 -> ((u1, u2), (v1, v2))) ptr
-   (uOrder, vOrder) <- allocaArray 2 $ \ptr -> do
+   (uOrder, vOrder) <- withArray [0,0] $ \ptr -> do
       glGetMapiv target (marshalGetMapQuery Order) ptr
       peek2 (,) ptr
    let vStride = numComponents dummyControlPoint

src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs

@@ -98,7 +98,7 @@ instance FramebufferAttachment BufferMode where
 
 getFBAParameteriv :: FramebufferAttachment fba => FramebufferTarget -> fba
     -> (GLint -> a) -> GLenum -> IO a
-getFBAParameteriv fbt fba f p = alloca $ \buf -> do
+getFBAParameteriv fbt fba f p = with 0 $ \buf -> do
    glGetFramebufferAttachmentParameteriv (marshalFramebufferTarget fbt)
       mfba p buf
    peek1 f buf

src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferTarget.hs

@@ -34,7 +34,7 @@ marshalRenderbufferTarget x = case x of
 
 getRBParameteriv :: RenderbufferTarget -> (GLint -> a) -> GLenum -> IO a
 getRBParameteriv rbt f p =
-   alloca $ \buf -> do
+   with 0 $ \buf -> do
       glGetRenderbufferParameteriv (marshalRenderbufferTarget rbt) p buf
       peek1 f buf
 -----------------------------------------------------------------------------

src/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs

@@ -213,7 +213,7 @@ colorTableFormat ct =
 
 getColorTableParameteri :: (GLint -> a) -> ColorTable -> ColorTablePName -> IO a
 getColorTableParameteri f ct p =
-   alloca $ \buf -> do
+   with 0 $ \buf -> do
       glGetColorTableParameteriv
          (marshalColorTable ct)
          (marshalColorTablePName p)

src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs

@@ -184,7 +184,7 @@ convolutionParameteri t p =
 getConvolutionParameteri ::
    (GLint -> a) -> ConvolutionTarget -> ConvolutionParameter -> IO a
 getConvolutionParameteri f t p =
-   alloca $ \buf -> do
+   with 0 $ \buf -> do
       glGetConvolutionParameteriv
          (marshalConvolutionTarget t) (marshalConvolutionParameter p) buf
       peek1 f buf

src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs

@@ -18,7 +18,7 @@ module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram (
    histogramRGBASizes, histogramLuminanceSize
 ) where
 
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Graphics.Rendering.OpenGL.GL.Capability
 import Graphics.Rendering.OpenGL.GL.PeekPoke
 import Graphics.Rendering.OpenGL.GL.PixelData
@@ -63,7 +63,7 @@ getHistogram' proxy = do
 getHistogramParameteri ::
    (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
 getHistogramParameteri f proxy p =
-   alloca $ \buf -> do
+   with 0 $ \buf -> do
       glGetHistogramParameteriv
          (marshalHistogramTarget (proxyToHistogramTarget proxy))
          (marshalGetHistogramParameterPName p)

src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs

@@ -17,7 +17,7 @@ module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax (
    minmax, getMinmax, resetMinmax
 ) where
 
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Graphics.Rendering.OpenGL.GL.Capability
 import Graphics.Rendering.OpenGL.GL.PeekPoke
 import Graphics.Rendering.OpenGL.GL.PixelData
@@ -81,7 +81,7 @@ marshalGetMinmaxParameterPName x = case x of
 
 getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a
 getMinmaxParameteri f p =
-   alloca $ \buf -> do
+   with 0 $ \buf -> do
       glGetMinmaxParameteriv
          (marshalMinmaxTarget Minmax)
          (marshalGetMinmaxParameterPName p)

src/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs

@@ -15,7 +15,7 @@ module Graphics.Rendering.OpenGL.GL.PixellikeObject (
   PixellikeObjectTarget(pixellikeObjTarParam),
 ) where
 
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment
 import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget
 import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget
@@ -77,6 +77,6 @@ instance QueryableTextureTarget t => PixellikeObjectTarget (TextureTargetFull t)
       DepthSize -> gl_TEXTURE_DEPTH_SIZE
       StencilSize -> gl_TEXTURE_STENCIL_SIZE
    pixObjTarQueryFunc (TextureTargetFull t level) p =
-      alloca $ \buf -> do
+      with 0 $ \buf -> do
       glGetTexLevelParameteriv (marshalQueryableTextureTarget t) level p buf
       peek1 id buf

src/Graphics/Rendering/OpenGL/GL/QueryObjects.hs

@@ -31,6 +31,7 @@ module Graphics.Rendering.OpenGL.GL.QueryObjects (
 ) where
 
 import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.Exception
@@ -111,7 +112,7 @@ queryCounterBits = getQueryi fromIntegral QueryCounterBits
 getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
 getQueryi f p t =
    makeGettableStateVar $
-      alloca $ \buf -> do
+      with 0 $ \buf -> do
          getQueryiv' t p buf
          peek1 f buf
 

src/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs

@@ -19,6 +19,7 @@ module Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib (
 ) where
 
 import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.PeekPoke
@@ -55,7 +56,7 @@ marshalGetVertexAttribPName x = case x of
 --------------------------------------------------------------------------------
 
 getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribInteger1 f (AttribLocation location) n = alloca $ \buf -> do
+getVertexAttribInteger1 f (AttribLocation location) n = with 0 $ \buf -> do
    glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf
    peek1 f buf
 
@@ -92,6 +93,6 @@ marshalGetVertexAttribPointerPName x = case x of
 --------------------------------------------------------------------------------
 
 getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a)
-getVertexAttribPointer (AttribLocation location) n = alloca $ \buf -> do
+getVertexAttribPointer (AttribLocation location) n = with nullPtr $ \buf -> do
    glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf
    peek buf

src/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs

@@ -20,7 +20,7 @@ module Graphics.Rendering.OpenGL.GL.Shaders.Program (
    programVar1, programVar3
 ) where
 
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Graphics.Rendering.OpenGL.GL.GLboolean
 import Graphics.Rendering.OpenGL.GL.ObjectName
@@ -109,6 +109,6 @@ programVar3 = programVarN . peek3
 programVarN :: (Ptr GLint -> IO a) -> GetProgramPName -> Program -> GettableStateVar a
 programVarN f p program =
    makeGettableStateVar $
-      alloca $ \buf -> do
+      with 0 $ \buf -> do
          glGetProgramiv (programID program) (marshalGetProgramPName p) buf
          f buf

src/Graphics/Rendering/OpenGL/GL/Shaders/ShaderObjects.hs

@@ -153,7 +153,7 @@ marshalGetShaderPName x = case x of
 shaderVar :: (GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
 shaderVar f p shader =
    makeGettableStateVar $
-      alloca $ \buf -> do
+      with 0 $ \buf -> do
          glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf
          peek1 f buf
 

src/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs

@@ -19,7 +19,7 @@ module Graphics.Rendering.OpenGL.GL.Shaders.Variables (
 ) where
 
 import Control.Monad
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.ByteString
@@ -150,9 +150,9 @@ activeVars numVars maxLength getter unmarshalType p@(Program program) =
    makeGettableStateVar $ do
       numActiveVars <- get (numVars p)
       maxLen <- get (maxLength p)
-      alloca $ \nameLengthBuf ->
-         alloca $ \sizeBuf ->
-            alloca $ \typeBuf ->
+      with 0 $ \nameLengthBuf ->
+         with 0 $ \sizeBuf ->
+            with 0 $ \typeBuf ->
                let ixs = if numActiveVars > 0 then [0 .. numActiveVars-1] else []
                in forM ixs $ \i -> do
                   n <- createAndTrimByteString maxLen $ \nameBuf -> do

src/Graphics/Rendering/OpenGL/GL/SyncObjects.hs

@@ -25,7 +25,7 @@ module Graphics.Rendering.OpenGL.GL.SyncObjects (
    SyncStatus(..), syncStatus
 ) where
 
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Graphics.Rendering.OpenGL.GL.GLboolean
 import Graphics.Rendering.OpenGL.GL.ObjectName
@@ -108,6 +108,6 @@ unmarshalSyncStatus x
 syncStatus :: SyncObject -> GettableStateVar SyncStatus
 syncStatus syncObject =
    makeGettableStateVar $
-      alloca $ \buf -> do
+      with 0 $ \buf -> do
          glGetSynciv (syncID syncObject) gl_SYNC_STATUS 1 nullPtr buf
          peek1 (unmarshalSyncStatus . fromIntegral) buf

src/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs

@@ -20,7 +20,7 @@ module Graphics.Rendering.OpenGL.GL.Texturing.Queries (
 ) where
 
 import Control.Monad
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Graphics.Rendering.OpenGL.GL.GLboolean
 import Graphics.Rendering.OpenGL.GL.PeekPoke
 import Graphics.Rendering.OpenGL.GL.PixelRectangles
@@ -157,6 +157,6 @@ getTexLevelParameteriNoProxy f = getTexLevelParameteri f . marshalQueryableTextu
 
 getTexLevelParameteri :: (GLint -> a) -> GLenum -> Level -> TexLevelParameter -> IO a
 getTexLevelParameteri f t level p =
-   alloca $ \buf -> do
+   with 0 $ \buf -> do
       glGetTexLevelParameteriv t level (marshalTexLevelParameter p) buf
       peek1 f buf

src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs

@@ -35,7 +35,7 @@ module Graphics.Rendering.OpenGL.GL.VertexArrays (
    vertexAttribPointer, vertexAttribArray,
 ) where
 
-import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.Capability
@@ -438,7 +438,7 @@ marshalGetPointervPName x = case x of
 --------------------------------------------------------------------------------
 
 getPointer :: GetPointervPName -> IO (Ptr a)
-getPointer n = alloca $ \buf -> do
+getPointer n = with nullPtr $ \buf -> do
    glGetPointerv (marshalGetPointervPName n) buf
    peek buf