diff --git a/Language/GLSL/Tests.hs b/Language/GLSL/Tests.hs deleted file mode 100644 --- a/Language/GLSL/Tests.hs +++ /dev/null @@ -1,459 +0,0 @@ -module Language.GLSL.Tests where - -import Text.ParserCombinators.Parsec hiding (State, parse) -- TODO clean -import Text.PrettyPrint.HughesPJClass (prettyShow, Pretty) -import Test.HUnit - -import Language.GLSL.Syntax -import Language.GLSL.Parser -import Language.GLSL.Pretty () - ----------------------------------------------------------------------- --- exported tests ----------------------------------------------------------------------- - -tests :: IO () -tests = do - mapM_ runTestTT parsingTests - return () - -parsingTests :: [Test] -parsingTests = - [ legalExpressionsTests - , illegalExpressionsTests - , legalDeclarationsTests - , illegalDeclarationsTests - , legalFunctionDefinitionsTests - - , legalCommentsTests - , illegalCommentsTests - - , TestLabel "expressions id" $ TestList $ - map expressionsId testExpressionsTrue - , TestLabel "declarations id" $ TestList $ - map declarationsId testDeclarationsTrue - , TestLabel "function definitions id" $ TestList $ - map functionDefinitionsId testFunctionDefinitionsTrue - ] - ----------------------------------------------------------------------- --- For QuickCheck testing ----------------------------------------------------------------------- - --- Given an AST ast, pretty-print it and parse it back. The result be --- equal to the original ast, i.e. (parse . pretty) == id --- TODO refactor the common parts --- TODO Befor it is possible to use QC, the AST should enforce more --- constraints, and some sanity check funtions should be provided --- (to build only legal ASTs). - -parsePrettyId :: TranslationUnit -> Bool -parsePrettyId e = case pass translationUnit (prettyShow e) of - Left _ -> False - Right e' -> e == e' - -parsePrettyIdExpr :: Expr -> Bool -parsePrettyIdExpr e = case pass expression (prettyShow e) of - Left _ -> False - Right e' -> e == e' - -parsePrettyIdDecl :: Declaration -> Bool -parsePrettyIdDecl e = case pass declaration (prettyShow e) of - Left _ -> False - Right e' -> e == e' - -check :: Pretty a => P a -> String -> IO () -check p str = case pass p str of - Left err -> print err - Right ast -> putStrLn $ prettyShow ast - -parsePrettyIdFunc :: ExternalDeclaration -> Bool -parsePrettyIdFunc e = case pass functionDefinition (prettyShow e) of - Left _ -> False - Right e' -> e == e' - -expressionsId :: String -> Test -expressionsId str = TestCase . assertBool ("expressionsId: " ++ str) . parsePrettyIdExpr $ ast - where ast = case pass expression str of - Left _ -> error "does not even parse the original string" - Right a -> a - -declarationsId :: String -> Test -declarationsId str = TestCase . assertBool ("declarationsId: " ++ str) . parsePrettyIdDecl $ ast - where ast = case pass declaration str of - Left _ -> error "does not even parse the original string" - Right a -> a - -functionDefinitionsId :: String -> Test -functionDefinitionsId str = TestCase . assertBool ("functionDefinitionsId: " ++ str) . parsePrettyIdFunc $ ast - where ast = case pass functionDefinition str of - Left _ -> error "does not even parse the original string" - Right a -> a - ----------------------------------------------------------------------- --- helpers ----------------------------------------------------------------------- - --- Just check if the parser passes of fails -pass :: P a -> String -> Either ParseError a -pass p = runParser (do {skipMany blank ; r <- p ; eof ; return r}) S "pass" - -isRight :: Either a b -> Bool -isRight (Right _) = True -isRight (Left _) = False - -isLeft :: Either a b -> Bool -isLeft = not . isRight - -doesParse :: P a -> String -> Test -doesParse p str = - TestCase . assertBool ("doesParse: " ++ str) . isRight . pass p $ str - -doesNotParse :: P a -> String -> Test -doesNotParse p str = - TestCase . assertBool ("doesNotParse: " ++ str) . isLeft . pass p $ str - ----------------------------------------------------------------------- --- expressions ----------------------------------------------------------------------- - -legalExpressionsTests :: Test -legalExpressionsTests = TestLabel "legal expressions" $ - TestList $ map (doesParse expression) testExpressionsTrue - -illegalExpressionsTests :: Test -illegalExpressionsTests = TestLabel "illegal expressions" $ - TestList $ map (doesNotParse expression) testExpressionsFalse - -testExpressionsTrue :: [String] -testExpressionsTrue = - [ "a" - , "avoid" - , "filters" - , "0" - , "1" - , ".1" - , "0x01" - , "0xF" - , "07" - , "a++" - , "a--" - , "a++--" - , "a--++" - , "a++++" - , "a----" - , "++a" - , "--a" - , "++--a" - , "--++a" - , "++++a" - , "----a" - , "a ++" - , "+a" - , "+ a" - , "a + b" - , "a + b++" - , "a + ++b" - , "a + + b" - , "a ++ +b" - , "a()" - , "float()" - , "a ()" - , "a( )" - , "a ( )" - , "a.a" - , "a.a()" - , "a.length()" - , "a[1]" - , "a[1].x" - , "a[1].x()" - , "a().b" - , "a().b[1]" - , "a().b()" - , "a.b.c" - ] - -testExpressionsFalse :: [String] -testExpressionsFalse = - [ "void" - , "filter" - , ".A" - , "08" - , "0A" - , "+" - , "++" - , "a+" - , "a +" - , "a . a" -- TODO should it be allowed ? - , "a[]" --- , "a[1][2]" -- TODO it is illegal to declare an array of arrays - ] - ----------------------------------------------------------------------- --- declarations ----------------------------------------------------------------------- - -legalDeclarationsTests :: Test -legalDeclarationsTests = TestLabel "legal declarations" $ - TestList $ map (doesParse declaration) testDeclarationsTrue - -illegalDeclarationsTests :: Test -illegalDeclarationsTests = TestLabel "illegal declarations" $ - TestList $ map (doesNotParse declaration) testDeclarationsFalse - -testDeclarationsTrue :: [String] -testDeclarationsTrue = - [ "int a;" - , "int a, b, c;" - , "precision highp float;" - , "int a = 1;" - , "struct a { int b; };" - , "struct a { int b; float c; };" - , "layout (origin_upper_left) in;" - , "layout (origin_upper_left) in vec4 gl_FragCoord;" - , "layout (origin_upper_left, pixel_center_integer) in vec4 gl_FragCoord;" - , "bool success;" - , "bool done = false;" - , "int a = 123;" - , "int a = 123u;" - , "int a = 123U;" - , "int a = 0123;" - , "int a = 0123u;" - , "int a = 0123U;" - , "int a = 0x123;" - , "int a = 0x123u;" - , "int a = 0x123U;" - , "int a = 0x12ABu;" - , "int a = 0x12ABU;" - , "int a = 0X123;" - , "int a = 0X123u;" - , "int a = 0X123U;" - , "int a = 0X12ABu;" - , "int a = 0X12ABU;" - , "float a = 1.0;" - , "float a = 1.;" - , "float a = .0;" - , "float a = 1e1;" - , "float a = 1.0e1;" - , "float a = 1.e1;" - , "float a = 1.0e-1;" - , "float a = 1.0e+1;" - , "float a = 1.0e+1f;" - , "float a = 1.0e+1F;" - , "vec2 texcoord1, texcoord2;" - , "mat3x2 m;" - , "struct light { float intensity; vec3 position; } lightVar;" - , "const struct light { float intensity; vec3 position; } lightVar;" - , "float frequencies[3];" - , "uniform vec4 lightPosition[4];" - , "light lights[];" - , "const int numLights = 2;" - , "light lights[numLights];" - , "float[5] a;" - , "float a[5];" - , "float a[5] = float[](3.4, 4.2, 5.0, 5.2, 1.1);" - , "float a[5] = float[5](3.4, 4.2, 5.0, 5.2, 1.1);" - , "const int a;" - , "in int a;" - , "centroid in int a;" - , "smooth in int a;" - - , "bool success;" - , "bool done = false;" - , "int i;" - , "int i, j = 42;" - , "int j = 1;" - , "uint k = 3u;" - , "float x = 1.0;" - , "float a = 1.5, b;" - , "vec2 texcoord1, texcoord2;" - , "vec3 position;" - , "vec4 myRGBA;" - , "ivec2 textureLookup;" - , "bvec3 less;" - , "mat2 mat2D;" - , "mat3 optMatrix;" - , "mat4 view;" - , "mat3x2 m;" - , "struct light\ - \{\ - \float intensity;\ - \vec3 position;\ - \} lightVar;" - , "light lightVar3;" - , "float frequencies[3];" - , "uniform vec4 lightPosition[4];" - , "light lights[];" - , "const int numLights = 2;" - , "light lights[numLights];" - , "int a[5];" - , "const float coef = 2.75;" - , "const vec3 zAxis = vec3 (0.0, 0.0, 1.0);" - , "in vec4 position;" - , "in vec3 normal;" - , "in vec2 texCoord[4];" - , "in float foo[];" - , "centroid out vec2 TexCoord;" - , "invariant centroid out vec4 Color;" - , "invariant flat centroid out vec4 Color;" - , "noperspective out float temperature;" - , "flat out vec3 myColor;" - , "noperspective centroid out vec2 myTexCoord;" - , "out vec4 FragmentColor;" - , "out uint Luminosity;" - , "uniform Transform\ - \{\ - \ mat4 ModelViewMatrix;\ - \ mat4 ModelViewProjectionMatrix;\ - \ uniform mat3 NormalMatrix;\ - \ float Deformation;\ - \};" - , "in Material\ - \{\ - \ smooth in vec4 Color1;\ - \ smooth vec4 Color2;\ - \ vec2 TexCoord;\ - \};" - , "out Vertex\ - \{\ - \ vec4 Position;\ - \ vec2 Texture;\ - \} Coords;" - , "uniform Transform {\ - \ mat4 ModelViewMatrix;\ - \ mat4 ModelViewProjectionMatrix;\ - \ float Deformation;\ - \} transforms[4];" - , "layout (triangles) in;" - , "layout (origin_upper_left) in vec4 gl_FragCoord;" - , "layout (pixel_center_integer) in vec4 gl_FragCoord;" - , "layout (origin_upper_left, pixel_center_integer) in vec4 gl_FragCoord;" - , "layout (triangle_strip, max_vertices = 60) out;" - , "layout (triangle_strip) out;" - , "layout (max_vertices = 60) out;" - , "layout (shared, column_major) uniform;" - , "layout (std140) uniform Transform {\ - \ mat4 M1;\ - \ layout (column_major) mat4 M2;\ - \ mat3 N1;\ - \};" - , "flat out vec4 gl_FrontColor;" - , "lowp float color;" - , "out mediump vec2 P;" - , "highp mat4 m;" - , "precision highp float;" - , "precision highp int;" - , "precision mediump int;" - , "invariant gl_Position;" - , "out vec3 Color;" - , "invariant Color;" - , "invariant centroid out vec3 Color;" - , "vec4 color = vec4(0.0, 1.0, 0.0, 1.0);" - , "int i = 1 - 5 * 4 + 3;" - , "int i = 1 - (5 * 4) + 3;" - , "int i = (1 - 5) * 4 + 3;" - , "int i = (1 - 5) * (4 + 3);" - , "bool b = 1 < 2;" - - ] - -testDeclarationsFalse :: [String] -testDeclarationsFalse = - [ "int a" - , "int a, b c;" - , "precision high float;" - , "precision float f();" - , "int float;" - , "struct a { };" - , "struct a { int b, float c; };" - , "int a = 0128;" - , "int a = 0xu;" - , "float a = .e1;" - , "float a = 1.0e+1G;" -{- TODO embeded structs are not possible. - , "struct light {\ - \ struct { float intensity; };\ - \ vec3 position;\ - \} lightVar;" --} - , "int f();" -- function declaration should be at top level -- TODO put these in legalTranslationUnitsTests - , "int f(void);" - , "int f ( void ) ;" - , "lowp ivec2 foo(lowp mat3);" - , "float[5] foo();" - , "void foo (float[5]);" - , "void foo (float a[5]);" - , "float[] foo();" - , "float[5] foo();" - , "float[5] foo(int[4]);" - , "int f ();" --- TODO qualifier only possible where declarators. --- , "const struct light { float intensity; vec3 position; };" - , "float a[5][3];" --- interpolation qualifier may only preced [centroid]in/out. --- , "smooth const int a;" - ] - ----------------------------------------------------------------------- --- function definitions ----------------------------------------------------------------------- - -legalFunctionDefinitionsTests :: Test -legalFunctionDefinitionsTests = TestLabel "legal function definition" $ - TestList $ map (doesParse functionDefinition) testFunctionDefinitionsTrue - -testFunctionDefinitionsTrue :: [String] -testFunctionDefinitionsTrue = - [ "void main ()\n\ - \{\n\ - \}" - , "void main ()\n\ - \{\n\ - \ if (intensity < 0.0)\n\ - \ return;\n\ - \}" - ] - ----------------------------------------------------------------------- --- comments (inside simple declarations) ----------------------------------------------------------------------- - -legalCommentsTests :: Test -legalCommentsTests = TestLabel "legal comments" $ - TestList $ map (doesParse declaration) testCommentsTrue - -illegalCommentsTests :: Test -illegalCommentsTests = TestLabel "illegal comments" $ - TestList $ map (doesNotParse declaration) testCommentsFalse - -testCommentsTrue :: [String] -testCommentsTrue = - [ "int a; // a comment" - , "int a; /* another comment */" - , "int a; // a comment\n" - , "int a; /* another comment */\n" - , "int a; /* another comment\non multiple\nlines.*/" - , "int a; /* another comment\non multiple\nlines.*/\n" - , "int a; /* another comment\non multiple\nlines.\n*/" - , "/* before */ int a;" - , "// before\nint a;" - , "int /* middle */ a;" - , "int/* middle */a;" - , "int a/* middle */;" - , "int a; /* not a // nested comment */" - ] - -testCommentsFalse :: [String] -testCommentsFalse = - [ "int a; /* no /* nested */ comment */" - ] - ----------------------------------------------------------------------- --- translation unit ----------------------------------------------------------------------- - -legalTranslationUnitsTests :: Test -legalTranslationUnitsTests = TestLabel "legal translation unit" $ - TestList $ map (doesParse translationUnit) $ - testDeclarationsTrue ++ testFunctionDefinitionsTrue - diff --git a/bin/glsl-pprint.hs b/bin/glsl-pprint.hs --- a/bin/glsl-pprint.hs +++ b/bin/glsl-pprint.hs @@ -4,7 +4,6 @@ import Text.PrettyPrint.HughesPJClass import Language.GLSL -import Language.GLSL.Tests (parsePrettyId, tests) info :: [String] info = @@ -13,24 +12,15 @@ usage :: [String] usage = info ++ - ["usage:\n glsl-pprint [-p] filename\n glsl-pprint --run-tests"] + ["usage:\n glsl-pprint [-p] filename"] main :: IO () main = do args <- getArgs case args of - ["--run-tests"] -> tests [fn] -> do content <- readFile fn putStrLn . show . parse $ content - ["--check", fn] -> do - content <- readFile fn - case parse content of - Left err -> putStrLn $ "parse error:\n" ++ show err - Right ast -> - if parsePrettyId ast - then putStrLn "parse . pretty == id" - else putStrLn "parse . pretty /= id" ["-p", fn] -> do content <- readFile fn case parse content of diff --git a/language-glsl.cabal b/language-glsl.cabal --- a/language-glsl.cabal +++ b/language-glsl.cabal @@ -1,5 +1,5 @@ name: language-glsl -version: 0.0.2 +version: 0.1.0 Cabal-Version: >= 1.8 synopsis: GLSL abstract syntax tree, parser, and pretty-printer description: @@ -20,24 +20,33 @@ library build-depends: base < 5, - HUnit, parsec, prettyclass ghc-options: -Wall exposed-modules: Language.GLSL, Language.GLSL.Parser, Language.GLSL.Pretty, - Language.GLSL.Syntax, - Language.GLSL.Tests + Language.GLSL.Syntax executable glsl-pprint main-is: glsl-pprint.hs hs-source-dirs: bin/ build-depends: base < 5, - HUnit, language-glsl, parsec, pretty, prettyclass ghc-options: -Wall +Test-Suite tests + Type: exitcode-stdio-1.0 + build-depends: base < 5, + HUnit, + language-glsl, + parsec, + prettyclass, + test-framework, + test-framework-hunit + ghc-options: -Wall + Hs-Source-Dirs: tests + main-is: Tests.hs diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,471 @@ +module Main where + +import Text.ParserCombinators.Parsec hiding (State, parse) -- TODO clean +import Text.PrettyPrint.HughesPJClass (prettyShow, Pretty) +import Test.HUnit +import Test.Framework (defaultMain) +import Test.Framework.Providers.HUnit (hUnitTestToTests) + +import Language.GLSL.Syntax +import Language.GLSL.Parser +import Language.GLSL.Pretty () + +main :: IO () +main = defaultMain . hUnitTestToTests . TestList $ parsingTests + +parsingTests :: [Test] +parsingTests = + [ legalExpressionsTests + , illegalExpressionsTests + , legalDeclarationsTests + , illegalDeclarationsTests + , legalFunctionDefinitionsTests + + , legalCommentsTests + , illegalCommentsTests + + , TestLabel "expressions id" $ TestList $ + map expressionsId testExpressionsTrue + , TestLabel "declarations id" $ TestList $ + map declarationsId testDeclarationsTrue + , TestLabel "function definitions id" $ TestList $ + map functionDefinitionsId testFunctionDefinitionsTrue + + , sampleFileTest + ] + +---------------------------------------------------------------------- +-- For QuickCheck testing +---------------------------------------------------------------------- + +-- Given an AST ast, pretty-print it and parse it back. The result be +-- equal to the original ast, i.e. (parse . pretty) == id +-- TODO refactor the common parts +-- TODO Befor it is possible to use QC, the AST should enforce more +-- constraints, and some sanity check funtions should be provided +-- (to build only legal ASTs). + +parsePrettyId :: TranslationUnit -> Bool +parsePrettyId e = case pass translationUnit (prettyShow e) of + Left _ -> False + Right e' -> e == e' + +parsePrettyIdExpr :: Expr -> Bool +parsePrettyIdExpr e = case pass expression (prettyShow e) of + Left _ -> False + Right e' -> e == e' + +parsePrettyIdDecl :: Declaration -> Bool +parsePrettyIdDecl e = case pass declaration (prettyShow e) of + Left _ -> False + Right e' -> e == e' + +check :: Pretty a => P a -> String -> IO () +check p str = case pass p str of + Left err -> print err + Right ast -> putStrLn $ prettyShow ast + +parsePrettyIdFunc :: ExternalDeclaration -> Bool +parsePrettyIdFunc e = case pass functionDefinition (prettyShow e) of + Left _ -> False + Right e' -> e == e' + +expressionsId :: String -> Test +expressionsId str = TestCase . assertBool ("expressionsId: " ++ str) . parsePrettyIdExpr $ ast + where ast = case pass expression str of + Left _ -> error "does not even parse the original string" + Right a -> a + +declarationsId :: String -> Test +declarationsId str = TestCase . assertBool ("declarationsId: " ++ str) . parsePrettyIdDecl $ ast + where ast = case pass declaration str of + Left _ -> error "does not even parse the original string" + Right a -> a + +functionDefinitionsId :: String -> Test +functionDefinitionsId str = TestCase . assertBool ("functionDefinitionsId: " ++ str) . parsePrettyIdFunc $ ast + where ast = case pass functionDefinition str of + Left _ -> error "does not even parse the original string" + Right a -> a + +---------------------------------------------------------------------- +-- helpers +---------------------------------------------------------------------- + +-- Just check if the parser passes of fails +pass :: P a -> String -> Either ParseError a +pass p = runParser (do {skipMany blank ; r <- p ; eof ; return r}) S "pass" + +isRight :: Either a b -> Bool +isRight (Right _) = True +isRight (Left _) = False + +isLeft :: Either a b -> Bool +isLeft = not . isRight + +doesParse :: P a -> String -> Test +doesParse p str = + TestCase . assertBool ("doesParse: " ++ str) . isRight . pass p $ str + +doesNotParse :: P a -> String -> Test +doesNotParse p str = + TestCase . assertBool ("doesNotParse: " ++ str) . isLeft . pass p $ str + +---------------------------------------------------------------------- +-- expressions +---------------------------------------------------------------------- + +legalExpressionsTests :: Test +legalExpressionsTests = TestLabel "legal expressions" $ + TestList $ map (doesParse expression) testExpressionsTrue + +illegalExpressionsTests :: Test +illegalExpressionsTests = TestLabel "illegal expressions" $ + TestList $ map (doesNotParse expression) testExpressionsFalse + +testExpressionsTrue :: [String] +testExpressionsTrue = + [ "a" + , "avoid" + , "filters" + , "0" + , "1" + , ".1" + , "0x01" + , "0xF" + , "07" + , "a++" + , "a--" + , "a++--" + , "a--++" + , "a++++" + , "a----" + , "++a" + , "--a" + , "++--a" + , "--++a" + , "++++a" + , "----a" + , "a ++" + , "+a" + , "+ a" + , "a + b" + , "a + b++" + , "a + ++b" + , "a + + b" + , "a ++ +b" + , "a()" + , "float()" + , "a ()" + , "a( )" + , "a ( )" + , "a.a" + , "a.a()" + , "a.length()" + , "a[1]" + , "a[1].x" + , "a[1].x()" + , "a().b" + , "a().b[1]" + , "a().b()" + , "a.b.c" + ] + +testExpressionsFalse :: [String] +testExpressionsFalse = + [ "void" + , "filter" + , ".A" + , "08" + , "0A" + , "+" + , "++" + , "a+" + , "a +" + , "a . a" -- TODO should it be allowed ? + , "a[]" +-- , "a[1][2]" -- TODO it is illegal to declare an array of arrays + ] + +---------------------------------------------------------------------- +-- declarations +---------------------------------------------------------------------- + +legalDeclarationsTests :: Test +legalDeclarationsTests = TestLabel "legal declarations" $ + TestList $ map (doesParse declaration) testDeclarationsTrue + +illegalDeclarationsTests :: Test +illegalDeclarationsTests = TestLabel "illegal declarations" $ + TestList $ map (doesNotParse declaration) testDeclarationsFalse + +testDeclarationsTrue :: [String] +testDeclarationsTrue = + [ "int a;" + , "int a, b, c;" + , "precision highp float;" + , "int a = 1;" + , "struct a { int b; };" + , "struct a { int b; float c; };" + , "layout (origin_upper_left) in;" + , "layout (origin_upper_left) in vec4 gl_FragCoord;" + , "layout (origin_upper_left, pixel_center_integer) in vec4 gl_FragCoord;" + , "bool success;" + , "bool done = false;" + , "int a = 123;" + , "int a = 123u;" + , "int a = 123U;" + , "int a = 0123;" + , "int a = 0123u;" + , "int a = 0123U;" + , "int a = 0x123;" + , "int a = 0x123u;" + , "int a = 0x123U;" + , "int a = 0x12ABu;" + , "int a = 0x12ABU;" + , "int a = 0X123;" + , "int a = 0X123u;" + , "int a = 0X123U;" + , "int a = 0X12ABu;" + , "int a = 0X12ABU;" + , "float a = 1.0;" + , "float a = 1.;" + , "float a = .0;" + , "float a = 1e1;" + , "float a = 1.0e1;" + , "float a = 1.e1;" + , "float a = 1.0e-1;" + , "float a = 1.0e+1;" + , "float a = 1.0e+1f;" + , "float a = 1.0e+1F;" + , "vec2 texcoord1, texcoord2;" + , "mat3x2 m;" + , "struct light { float intensity; vec3 position; } lightVar;" + , "const struct light { float intensity; vec3 position; } lightVar;" + , "float frequencies[3];" + , "uniform vec4 lightPosition[4];" + , "light lights[];" + , "const int numLights = 2;" + , "light lights[numLights];" + , "float[5] a;" + , "float a[5];" + , "float a[5] = float[](3.4, 4.2, 5.0, 5.2, 1.1);" + , "float a[5] = float[5](3.4, 4.2, 5.0, 5.2, 1.1);" + , "const int a;" + , "in int a;" + , "centroid in int a;" + , "smooth in int a;" + + , "bool success;" + , "bool done = false;" + , "int i;" + , "int i, j = 42;" + , "int j = 1;" + , "uint k = 3u;" + , "float x = 1.0;" + , "float a = 1.5, b;" + , "vec2 texcoord1, texcoord2;" + , "vec3 position;" + , "vec4 myRGBA;" + , "ivec2 textureLookup;" + , "bvec3 less;" + , "mat2 mat2D;" + , "mat3 optMatrix;" + , "mat4 view;" + , "mat3x2 m;" + , "struct light\ + \{\ + \float intensity;\ + \vec3 position;\ + \} lightVar;" + , "light lightVar3;" + , "float frequencies[3];" + , "uniform vec4 lightPosition[4];" + , "light lights[];" + , "const int numLights = 2;" + , "light lights[numLights];" + , "int a[5];" + , "const float coef = 2.75;" + , "const vec3 zAxis = vec3 (0.0, 0.0, 1.0);" + , "in vec4 position;" + , "in vec3 normal;" + , "in vec2 texCoord[4];" + , "in float foo[];" + , "centroid out vec2 TexCoord;" + , "invariant centroid out vec4 Color;" + , "invariant flat centroid out vec4 Color;" + , "noperspective out float temperature;" + , "flat out vec3 myColor;" + , "noperspective centroid out vec2 myTexCoord;" + , "out vec4 FragmentColor;" + , "out uint Luminosity;" + , "uniform Transform\ + \{\ + \ mat4 ModelViewMatrix;\ + \ mat4 ModelViewProjectionMatrix;\ + \ uniform mat3 NormalMatrix;\ + \ float Deformation;\ + \};" + , "in Material\ + \{\ + \ smooth in vec4 Color1;\ + \ smooth vec4 Color2;\ + \ vec2 TexCoord;\ + \};" + , "out Vertex\ + \{\ + \ vec4 Position;\ + \ vec2 Texture;\ + \} Coords;" + , "uniform Transform {\ + \ mat4 ModelViewMatrix;\ + \ mat4 ModelViewProjectionMatrix;\ + \ float Deformation;\ + \} transforms[4];" + , "layout (triangles) in;" + , "layout (origin_upper_left) in vec4 gl_FragCoord;" + , "layout (pixel_center_integer) in vec4 gl_FragCoord;" + , "layout (origin_upper_left, pixel_center_integer) in vec4 gl_FragCoord;" + , "layout (triangle_strip, max_vertices = 60) out;" + , "layout (triangle_strip) out;" + , "layout (max_vertices = 60) out;" + , "layout (shared, column_major) uniform;" + , "layout (std140) uniform Transform {\ + \ mat4 M1;\ + \ layout (column_major) mat4 M2;\ + \ mat3 N1;\ + \};" + , "flat out vec4 gl_FrontColor;" + , "lowp float color;" + , "out mediump vec2 P;" + , "highp mat4 m;" + , "precision highp float;" + , "precision highp int;" + , "precision mediump int;" + , "invariant gl_Position;" + , "out vec3 Color;" + , "invariant Color;" + , "invariant centroid out vec3 Color;" + , "vec4 color = vec4(0.0, 1.0, 0.0, 1.0);" + , "int i = 1 - 5 * 4 + 3;" + , "int i = 1 - (5 * 4) + 3;" + , "int i = (1 - 5) * 4 + 3;" + , "int i = (1 - 5) * (4 + 3);" + , "bool b = 1 < 2;" + + ] + +testDeclarationsFalse :: [String] +testDeclarationsFalse = + [ "int a" + , "int a, b c;" + , "precision high float;" + , "precision float f();" + , "int float;" + , "struct a { };" + , "struct a { int b, float c; };" + , "int a = 0128;" + , "int a = 0xu;" + , "float a = .e1;" + , "float a = 1.0e+1G;" +{- TODO embeded structs are not possible. + , "struct light {\ + \ struct { float intensity; };\ + \ vec3 position;\ + \} lightVar;" +-} + , "int f();" -- function declaration should be at top level -- TODO put these in legalTranslationUnitsTests + , "int f(void);" + , "int f ( void ) ;" + , "lowp ivec2 foo(lowp mat3);" + , "float[5] foo();" + , "void foo (float[5]);" + , "void foo (float a[5]);" + , "float[] foo();" + , "float[5] foo();" + , "float[5] foo(int[4]);" + , "int f ();" +-- TODO qualifier only possible where declarators. +-- , "const struct light { float intensity; vec3 position; };" + , "float a[5][3];" +-- interpolation qualifier may only preced [centroid]in/out. +-- , "smooth const int a;" + ] + +---------------------------------------------------------------------- +-- function definitions +---------------------------------------------------------------------- + +legalFunctionDefinitionsTests :: Test +legalFunctionDefinitionsTests = TestLabel "legal function definition" $ + TestList $ map (doesParse functionDefinition) testFunctionDefinitionsTrue + +testFunctionDefinitionsTrue :: [String] +testFunctionDefinitionsTrue = + [ "void main ()\n\ + \{\n\ + \}" + , "void main ()\n\ + \{\n\ + \ if (intensity < 0.0)\n\ + \ return;\n\ + \}" + ] + +---------------------------------------------------------------------- +-- comments (inside simple declarations) +---------------------------------------------------------------------- + +legalCommentsTests :: Test +legalCommentsTests = TestLabel "legal comments" $ + TestList $ map (doesParse declaration) testCommentsTrue + +illegalCommentsTests :: Test +illegalCommentsTests = TestLabel "illegal comments" $ + TestList $ map (doesNotParse declaration) testCommentsFalse + +testCommentsTrue :: [String] +testCommentsTrue = + [ "int a; // a comment" + , "int a; /* another comment */" + , "int a; // a comment\n" + , "int a; /* another comment */\n" + , "int a; /* another comment\non multiple\nlines.*/" + , "int a; /* another comment\non multiple\nlines.*/\n" + , "int a; /* another comment\non multiple\nlines.\n*/" + , "/* before */ int a;" + , "// before\nint a;" + , "int /* middle */ a;" + , "int/* middle */a;" + , "int a/* middle */;" + , "int a; /* not a // nested comment */" + ] + +testCommentsFalse :: [String] +testCommentsFalse = + [ "int a; /* no /* nested */ comment */" + ] + +---------------------------------------------------------------------- +-- translation unit +---------------------------------------------------------------------- + +legalTranslationUnitsTests :: Test +legalTranslationUnitsTests = TestLabel "legal translation unit" $ + TestList $ map (doesParse translationUnit) $ + testDeclarationsTrue ++ testFunctionDefinitionsTrue + +---------------------------------------------------------------------- +-- kitchen sink +---------------------------------------------------------------------- + +sampleFileTest :: Test +sampleFileTest = TestLabel "Parse/Pretty glsl/sample-01.glsl test" . TestCase . assert $ do + content <- readFile $ "glsl/sample-01.glsl" + case parse content of + Left err -> do + putStrLn $ "parse error: \n" ++ show err + return False + Right ast -> + return $ parsePrettyId ast +