From 159fdbcbdb8fa14f6e0577fa339fc7d22a6e50ce Mon Sep 17 00:00:00 2001
From: Csaba Hruska <csaba.hruska@gmail.com>
Date: Mon, 9 May 2016 00:42:04 +0200
Subject: add check for texture uniforms

---
 src/LambdaCube/GL/Backend.hs | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'src')

diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 282c281..f14d105 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -247,6 +247,19 @@ compileProgram p = do
         inTextureNames = programInTextures p
         inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms
         texUnis = [n | (n,_) <- inTextures, Map.member n (programUniforms p)]
+    let prgInTextures = Map.keys inTextureNames
+        uniInTextures = map fst inTextures
+    unless (S.fromList prgInTextures == S.fromList uniInTextures) $ fail $ unlines
+      [ "shader program uniform texture input mismatch!"
+      , "expected: " ++ show prgInTextures
+      , "actual: " ++ show uniInTextures
+      , "vertex shader:"
+      , vertexShader p
+      , "geometry shader:"
+      , fromMaybe "" (geometryShader p)
+      , "fragment shader:"
+      , fragmentShader p
+      ]
     --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie)
     --putStrLn $ "inUniNames: " ++ show inUniNames
     --putStrLn $ "inUniforms: " ++ show inUniforms
-- 
cgit v1.2.3