flatbuffers-0.1.0.0: test/FlatBuffers/Internal/Compiler/SemanticAnalysisSpec.hs
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module FlatBuffers.Internal.Compiler.SemanticAnalysisSpec where
import Data.Foldable ( fold )
import Data.Int
import Data.Text ( Text )
import qualified Data.Text as T
import qualified FlatBuffers.Internal.Compiler.Parser as P
import FlatBuffers.Internal.Compiler.SemanticAnalysis
import FlatBuffers.Internal.Compiler.SyntaxTree ( FileTree(..) )
import FlatBuffers.Internal.Compiler.ValidSyntaxTree
import TestImports
import Text.Megaparsec
import Text.RawString.QQ ( r )
spec :: Spec
spec =
describe "SemanticAnalysis" $ do
it "top-level identifiers cannot have duplicates in the same namespace" $ do
[r| namespace A; enum E:int{x} enum E:int{x} |] `shouldFail` "'A.E' declared more than once"
[r| enum E:int{x} enum E:int{x} |] `shouldFail` "'E' declared more than once"
[r| struct S{x:int;} struct S{x:int;} |] `shouldFail` "'S' declared more than once"
[r| table T{} table T{} |] `shouldFail` "'T' declared more than once"
[r| union U{x} union U{x} |] `shouldFail` "'U' declared more than once"
[r| union U{x} union U{x} |] `shouldFail` "'U' declared more than once"
[r| union X{x} table X{} |] `shouldFail` "'X' declared more than once"
it "top-level identifiers can be duplicates, if they live in different namespaces" $
[r|
namespace A;
union X{B.X}
namespace B;
table X{}
|] `shouldValidate` foldDecls
[ union ("A", UnionDecl "X" [UnionVal "B_X" (TypeRef "B" "X")])
, table ("B", TableDecl "X" NotRoot [])
]
describe "attributes" $ do
it "user defined attributes must be declared" $ do
[r| enum E : int (x) {Y} |] `shouldFail` "[E]: user defined attributes must be declared before use: x"
[r| struct S (x) { y: int;} |] `shouldFail` "[S]: user defined attributes must be declared before use: x"
[r| struct S { y: int (x);} |] `shouldFail` "[S.y]: user defined attributes must be declared before use: x"
[r| table T (x) {} |] `shouldFail` "[T]: user defined attributes must be declared before use: x"
[r| table T { y: int (x); } |] `shouldFail` "[T.y]: user defined attributes must be declared before use: x"
[r| union U (x) {Y} table Y{} |] `shouldFail` "[U]: user defined attributes must be declared before use: x"
it "user defined attributes can be used when declared" $ do
shouldSucceed [r| attribute x; enum E : int (x) {Y} |]
shouldSucceed [r| attribute x; struct S (x) { y: int;} |]
shouldSucceed [r| attribute x; struct S { y: int (x);} |]
shouldSucceed [r| attribute x; table T (x) {} |]
shouldSucceed [r| attribute x; table T { y: int (x); } |]
shouldSucceed [r| attribute x; union U (x) {Y} table Y{} |]
it "built-in attributes can be used without being declared" $
shouldSucceed
[r|
table T
(id,
deprecated,
required,
force_align,
bit_flags,
nested_flatbuffer,
flexbuffer,
key,
hash,
original_order,
native_inline,
native_default,
native_custom_alloc,
native_type
) {}
|]
describe "root type" $ do
it "flips the `isRoot` flag" $
[r|
table T{}
root_type T;
|] `shouldValidate`
table ("", TableDecl "T" (IsRoot Nothing) [])
it "can be paired with a file_identifier" $
[r|
table T{}
file_identifier "abcd";
root_type T;
|] `shouldValidate`
table ("", TableDecl "T" (IsRoot (Just "abcd")) [])
it "when set multiple times, the last declaration wins" $
[r|
file_identifier "abcd";
root_type T;
root_type T2;
file_identifier "efgh";
table T2{}
table T{}
|] `shouldValidate` foldDecls
[ table ("", TableDecl "T2" (IsRoot (Just "efgh")) [])
, table ("", TableDecl "T" NotRoot [])
]
it "must reference a table" $ do
[r| root_type E; enum E:int{x} |] `shouldFail` "root type must be a table"
[r| root_type S; struct S{x:int;} |] `shouldFail` "root type must be a table"
[r| root_type U; union U{T} table T{} |] `shouldFail` "root type must be a table"
[r| root_type string; |] `shouldFail` "type 'string' does not exist (checked in these namespaces: '')"
it "can reference tables in other namespaces" $
[r|
namespace A;
root_type B.T;
namespace A.B;
table T{}
file_identifier "abcd";
|] `shouldValidate`
table ("A.B", TableDecl "T" (IsRoot (Just "abcd")) [])
it "a file identifier on its own doesn't do anything" $
[r|
table T{}
file_identifier "abcd";
|] `shouldValidate`
table ("", TableDecl "T" NotRoot [])
describe "enums" $ do
it "simple" $
[r|
namespace Ns;
enum Color : uint32 { Red, Green, Blue }
|] `shouldValidate`
enum ("Ns", EnumDecl "Color" EWord32
[ EnumVal "Red" 0
, EnumVal "Green" 1
, EnumVal "Blue" 2
])
it "multiple enums in different namespaces" $
[r|
namespace A;
enum Color1 : uint32 { Red }
namespace B;
namespace ;
enum Color2 : uint32 { Green }
namespace A.B.C;
enum Color3 : uint32 { Blue }
|] `shouldValidate` foldDecls
[ enum ("A", EnumDecl "Color1" EWord32 [EnumVal "Red" 0] )
, enum ("", EnumDecl "Color2" EWord32 [EnumVal "Green" 0] )
, enum ("A.B.C", EnumDecl "Color3" EWord32 [EnumVal "Blue" 0] )
]
it "with explicit values" $
[r| enum Color : int32 { Red = -2, Green, Blue = 2 } |] `shouldValidate`
enum ("", EnumDecl "Color" EInt32
[ EnumVal "Red" (-2)
, EnumVal "Green" (-1)
, EnumVal "Blue" 2
])
it "with explicit values (min/maxBound)" $
[r| enum Color : int8 { Red = -128, Green, Blue = 127 } |] `shouldValidate`
enum ("", EnumDecl "Color" EInt8
[ EnumVal "Red" (toInteger (minBound :: Int8))
, EnumVal "Green" (-127)
, EnumVal "Blue" (toInteger (maxBound :: Int8))
])
it "with out-of-bounds values" $ do
[r|
namespace A.B;
enum Color : int8 { Red = -129, Green, Blue }
|] `shouldFail`
"[A.B.Color.Red]: enum value does not fit [-128; 127]"
[r|
enum Color : int8 { Red, Green, Blue = 128 }
|] `shouldFail`
"[Color.Blue]: enum value does not fit [-128; 127]"
it "with values out of order" $ do
[r| enum Color : int8 { Red = 3, Green = 2, Blue } |] `shouldFail`
"[Color]: enum values must be specified in ascending order"
[r| enum Color : int8 { Red = 3, Green = 3, Blue } |] `shouldFail`
"[Color]: enum values must be specified in ascending order"
it "with bit_flags" $
[r| enum Color : int8 (bit_flags) { Red, Green, Blue } |] `shouldFail`
"[Color]: `bit_flags` are not supported yet"
it "with duplicate values" $
[r| enum Color : int8 { Red, Green, Red, Gray, Green, Green, Black } |] `shouldFail`
"[Color]: 'Green', 'Red' declared more than once"
it "with invalid underlying type" $ do
[r| enum Color : double { Red, Green, Blue } |] `shouldFail`
"[Color]: underlying enum type must be integral"
[r| enum Color : TypeRef { Red, Green, Blue } |] `shouldFail`
"[Color]: underlying enum type must be integral"
[r| enum Color : [int] { Red, Green, Blue } |] `shouldFail`
"[Color]: underlying enum type must be integral"
describe "structs" $ do
it "simple" $
[r|
namespace Ns;
struct S {
x: int;
}
|] `shouldValidate`
struct ("Ns", StructDecl "S" 4 4
[ StructField "x" 0 0 SInt32
])
it "multiple fields" $
[r|
struct S {
x: ubyte;
y: double;
z: bool;
}
|] `shouldValidate`
struct ("", StructDecl "S" 8 24
[ StructField "x" 7 0 SWord8
, StructField "y" 0 8 SDouble
, StructField "z" 7 16 SBool
])
it "when unqualified TypeRef is ambiguous, types in namespaces closer to the struct are preferred" $ do
let enumVal = EnumVal "x" 0
mkEnum namespace ident = enum (namespace, EnumDecl ident EInt16 [enumVal])
[r|
namespace ; enum E1 : short{x} enum E2 : short{x} enum E3 : short{x}
namespace A; enum E1 : short{x} enum E2 : short{x}
namespace A.B; enum E1 : short{x}
namespace A.B.C; enum E1 : short{x} enum E2 : short{x} enum E3 : short{x}
namespace A.B;
struct S {
x: E1; // should be A.B.E1
y: E2; // should be A.E2
z: E3; // should be E3
}
|] `shouldValidate` foldDecls
[ mkEnum "" "E1", mkEnum "" "E2", mkEnum "" "E3"
, mkEnum "A" "E1", mkEnum "A" "E2"
, mkEnum "A.B" "E1"
, mkEnum "A.B.C" "E1", mkEnum "A.B.C" "E2", mkEnum "A.B.C" "E3"
, struct ("A.B", StructDecl "S" 2 6
[ StructField "x" 0 0 (SEnum (TypeRef "A.B" "E1") EInt16)
, StructField "y" 0 2 (SEnum (TypeRef "A" "E2") EInt16)
, StructField "z" 0 4 (SEnum (TypeRef "" "E3") EInt16)
])
]
it "when qualified TypeRef is ambiguous, types in namespaces closer to the struct are preferred" $ do
let enumVal = EnumVal "x" 0
mkEnum namespace ident = enum (namespace, EnumDecl ident EInt16 [enumVal])
[r|
namespace ; enum E1 : short{x} enum E2 : short{x} enum E3 : short{x}
namespace A; enum E1 : short{x} enum E2 : short{x} enum E3 : short{x}
namespace A.B; enum E1 : short{x} enum E2 : short{x} enum E3 : short{x}
namespace A.A; enum E1 : short{x} enum E2 : short{x}
namespace A.B.A; enum E1 : short{x}
namespace A.B.C.A; enum E1 : short{x} enum E2 : short{x} enum E3 : short{x}
namespace A.B;
struct S {
x: A.E1; // should be A.B.A.E1
y: A.E2; // should be A.A.E2
z: A.E3; // should be A.E3
}
|] `shouldValidate` foldDecls
[ mkEnum "" "E1", mkEnum "" "E2", mkEnum "" "E3"
, mkEnum "A" "E1", mkEnum "A" "E2", mkEnum "A" "E3"
, mkEnum "A.B" "E1", mkEnum "A.B" "E2", mkEnum "A.B" "E3"
, mkEnum "A.A" "E1", mkEnum "A.A" "E2"
, mkEnum "A.B.A" "E1"
, mkEnum "A.B.C.A" "E1", mkEnum "A.B.C.A" "E2", mkEnum "A.B.C.A" "E3"
, struct ("A.B", StructDecl "S" 2 6
[ StructField "x" 0 0 (SEnum (TypeRef "A.B.A" "E1") EInt16)
, StructField "y" 0 2 (SEnum (TypeRef "A.A" "E2") EInt16)
, StructField "z" 0 4 (SEnum (TypeRef "A" "E3") EInt16)
])
]
it "when TypeRef is ambiguous, types in namespaces closer to the struct are preferred, even if they're not valid" $
[r|
namespace A; struct X {x: int;}
namespace A.B; table X {}
struct S {
x: X;
}
|] `shouldFail`
"[A.B.S.x]: struct fields may only be integers, floating point, bool, enums, or other structs"
it "with field referencing an enum" $
[r|
namespace A;
enum Color : ushort { Blue }
struct S {
x: Color;
}
|] `shouldValidate` foldDecls
[ enum ("A", EnumDecl "Color" EWord16 [EnumVal "Blue" 0])
, struct ("A", StructDecl "S" 2 2
[ StructField "x" 0 0 (SEnum (TypeRef "A" "Color") EWord16)
])
]
it "with nested structs (backwards/forwards references)" $ do
let backwards = ("A.B", StructDecl "Backwards" 4 4 [ StructField "x" 0 0 SFloat ])
let forwards = ("A.B", StructDecl "Forwards" 4 4 [ StructField "y" 0 0 (SStruct backwards) ])
[r|
namespace A.B;
struct Backwards {
x: float;
}
struct S {
x1: B.Backwards;
x2: A.B.Forwards;
}
struct Forwards {
y: Backwards;
}
|] `shouldValidate` foldDecls
[ struct backwards
, struct ("A.B", StructDecl "S" 4 8
[ StructField "x1" 0 0 (SStruct backwards)
, StructField "x2" 0 4 (SStruct forwards)
])
, struct forwards
]
it "with reference to a table" $
[r|
namespace A;
table T {}
struct S {
x: A.T;
}
|] `shouldFail`
"[A.S.x]: struct fields may only be integers, floating point, bool, enums, or other structs"
it "with reference to a union" $
[r|
namespace A.B;
union U { X }
struct S {
x: U;
}
|] `shouldFail`
"[A.B.S.x]: struct fields may only be integers, floating point, bool, enums, or other structs"
it "with invalid reference" $
[r|
namespace X.Y.Z;
struct S {
x: A.T;
}
|] `shouldFail`
"[X.Y.Z.S.x]: type 'A.T' does not exist (checked in these namespaces: 'X.Y.Z', 'X.Y', 'X', '')"
it "with reference to a vector" $
[r| struct S { x: [byte]; } |] `shouldFail`
"[S.x]: struct fields may only be integers, floating point, bool, enums, or other structs"
it "with reference to a string" $
[r| struct S { x: string; } |] `shouldFail`
"[S.x]: struct fields may only be integers, floating point, bool, enums, or other structs"
it "with duplicate fields" $
[r| struct S { x: byte; x: int; } |] `shouldFail`
"[S]: 'x' declared more than once"
it "with `force_align` attribute" $ do
-- just 1 field
[r| struct S (force_align: 4) { x: int; } |] `shouldValidate` struct ("", StructDecl "S" 4 4 [StructField "x" 0 0 SInt32])
[r| struct S (force_align: 8) { x: int; } |] `shouldValidate` struct ("", StructDecl "S" 8 8 [StructField "x" 4 0 SInt32])
[r| struct S (force_align: 16) { x: int; } |] `shouldValidate` struct ("", StructDecl "S" 16 16 [StructField "x" 12 0 SInt32])
-- multiple fields
[r| struct S (force_align: 2) { x: byte; y: ushort; } |] `shouldValidate` struct ("", StructDecl "S" 2 4 [StructField "x" 1 0 SInt8, StructField "y" 0 2 SWord16])
[r| struct S (force_align: 4) { x: byte; y: ushort; } |] `shouldValidate` struct ("", StructDecl "S" 4 4 [StructField "x" 1 0 SInt8, StructField "y" 0 2 SWord16])
[r| struct S (force_align: 8) { x: byte; y: ushort; } |] `shouldValidate` struct ("", StructDecl "S" 8 8 [StructField "x" 1 0 SInt8, StructField "y" 4 2 SWord16])
[r| struct S (force_align: 16) { x: byte; y: ushort; } |] `shouldValidate` struct ("", StructDecl "S" 16 16 [StructField "x" 1 0 SInt8, StructField "y" 12 2 SWord16])
-- nested structs
let s1 = ("", StructDecl "S1" 2 2 [StructField "x" 1 0 SInt8])
let s2 = ("", StructDecl "S2" 4 4 [StructField "x" 0 0 SInt32])
let s = ("", StructDecl "S" 4 12
[ StructField "x" 2 0 (SStruct s1)
, StructField "y" 0 4 (SStruct s2)
, StructField "z" 3 8 SBool
])
[r|
struct S (force_align: 4) { x: S1; y: S2; z: bool; }
struct S1 (force_align: 2) { x: byte; }
struct S2 { x: int; }
|] `shouldValidate` foldDecls
[ struct s
, struct s1
, struct s2
]
it "with `force_align` attribute less than the struct's natural alignment" $
[r| struct S (force_align: 2) { x: byte; y: int; } |] `shouldFail`
"[S]: force_align must be a power of two integer ranging from the struct's natural alignment (in this case, 4) to 16"
it "with `force_align` attribute greater than 16" $
[r| struct S (force_align: 32) { x: int; } |] `shouldFail`
"[S]: force_align must be a power of two integer ranging from the struct's natural alignment (in this case, 4) to 16"
it "with `force_align` not a power of 2" $
[r| struct S (force_align: 9) { x: int; } |] `shouldFail`
"[S]: force_align must be a power of two integer ranging from the struct's natural alignment (in this case, 4) to 16"
it "with `force_align` given as a string" $
[r| struct S (force_align: "hello") { x: byte; } |] `shouldFail`
"[S]: expected attribute 'force_align' to have an integer value, e.g. 'force_align: 123'"
it "with deprecated field" $
[r| struct S { x: byte (deprecated); } |] `shouldFail`
"[S.x]: can't deprecate fields in a struct"
it "with required field" $
[r| struct S { x: byte (required); } |] `shouldFail`
"[S.x]: struct fields are already required, the 'required' attribute is redundant"
it "with id field" $
[r| struct S { x: byte (id: 0); } |] `shouldFail`
"[S.x]: struct fields cannot be reordered using the 'id' attribute"
it "with cyclic dependency" $
[r|
struct S {x: S1;}
struct S1 {x: S4; y: S2;}
struct S2 {x: byte; y: S3;}
struct S3 {x: S4; y: S1;}
struct S4 {x: byte;}
|] `shouldFail`
"[S1]: cyclic dependency detected [S1 -> S2 -> S3 -> S1] - structs cannot contain themselves, directly or indirectly"
describe "tables" $ do
it "empty" $
[r| table T{} |] `shouldValidate` table ("", TableDecl "T" NotRoot [])
it "with cyclic reference" $
[r| table T{x: T;} |] `shouldValidate`
table ("", TableDecl "T" NotRoot
[ TableField 0 "x" (TTable (TypeRef "" "T") Opt) False
])
it "with invalid reference" $ do
[r| table T { x: A.X; } |] `shouldFail` "[T.x]: type 'A.X' does not exist (checked in these namespaces: '')"
[r| table T { x: [A.X]; } |] `shouldFail` "[T.x]: type 'A.X' does not exist (checked in these namespaces: '')"
it "with duplicate fields" $
[r| table T { x: byte; x: int; } |] `shouldFail`
"[T]: 'x' declared more than once"
describe "with numeric/bool fields" $ do
it "simple" $
[r|
namespace A.B;
table T {
a: byte;
b: short;
c: int;
d: long;
e: ubyte;
f: ushort;
g: uint;
h: ulong;
i: float;
j: double;
k: bool;
}
|] `shouldValidate`
table ("A.B", TableDecl "T" NotRoot
[ TableField 0 "a" (TInt8 0) False
, TableField 1 "b" (TInt16 0) False
, TableField 2 "c" (TInt32 0) False
, TableField 3 "d" (TInt64 0) False
, TableField 4 "e" (TWord8 0) False
, TableField 5 "f" (TWord16 0) False
, TableField 6 "g" (TWord32 0) False
, TableField 7 "h" (TWord64 0) False
, TableField 8 "i" (TFloat 0) False
, TableField 9 "j" (TDouble 0) False
, TableField 10"k" (TBool (DefaultVal False)) False
]
)
it "with `required` attribute" $ do
let errorMsg = "[T.x]: only non-scalar fields (strings, vectors, unions, structs, tables) may be 'required'"
[r| table T {x: byte (required); } |] `shouldFail` errorMsg
[r| table T {x: short (required); } |] `shouldFail` errorMsg
[r| table T {x: int (required); } |] `shouldFail` errorMsg
[r| table T {x: long (required); } |] `shouldFail` errorMsg
[r| table T {x: ubyte (required); } |] `shouldFail` errorMsg
[r| table T {x: ushort (required); } |] `shouldFail` errorMsg
[r| table T {x: uint (required); } |] `shouldFail` errorMsg
[r| table T {x: ulong (required); } |] `shouldFail` errorMsg
[r| table T {x: float (required); } |] `shouldFail` errorMsg
[r| table T {x: double (required); } |] `shouldFail` errorMsg
[r| table T {x: bool (required); } |] `shouldFail` errorMsg
it "with `deprecated` attribute" $
[r|
namespace A.B;
table T {
a: byte (deprecated);
b: short (deprecated);
c: int (deprecated);
d: long (deprecated);
e: ubyte (deprecated);
f: ushort (deprecated);
g: uint (deprecated);
h: ulong (deprecated);
i: float (deprecated);
j: double (deprecated);
k: bool (deprecated);
}
|] `shouldValidate`
table ("A.B", TableDecl "T" NotRoot
[ TableField 0 "a" (TInt8 0) True
, TableField 1 "b" (TInt16 0) True
, TableField 2 "c" (TInt32 0) True
, TableField 3 "d" (TInt64 0) True
, TableField 4 "e" (TWord8 0) True
, TableField 5 "f" (TWord16 0) True
, TableField 6 "g" (TWord32 0) True
, TableField 7 "h" (TWord64 0) True
, TableField 8 "i" (TFloat 0) True
, TableField 9 "j" (TDouble 0) True
, TableField 10 "k" (TBool (DefaultVal False)) True
]
)
describe "with integer fields" $ do
it "with integer default values" $
[r|
table T {
a: byte = 127;
b: short = -32768;
c: int = 1;
d: long = 1.00;
e: ubyte = 2e1;
f: ushort = 200e-1;
}
|] `shouldValidate`
table ("", TableDecl "T" NotRoot
[ TableField 0 "a" (TInt8 127) False
, TableField 1 "b" (TInt16 (-32768)) False
, TableField 2 "c" (TInt32 1) False
, TableField 3 "d" (TInt64 1) False
, TableField 4 "e" (TWord8 20) False
, TableField 5 "f" (TWord16 20) False
]
)
it "with out-of-bounds default values" $ do
[r| table T { a: byte = -129; } |] `shouldFail` "[T.a]: default value does not fit [-128; 127]"
[r| table T { a: byte = 128; } |] `shouldFail` "[T.a]: default value does not fit [-128; 127]"
let errorMsg = "[T.a]: default value must be integral"
it "with decimal default values" $ do
[r| table T { a: byte = 1.1; } |] `shouldFail` errorMsg
[r| table T { a: byte = 2e-1; } |] `shouldFail` errorMsg
[r| table T { a: byte = 2.22e1; } |] `shouldFail` errorMsg
it "with boolean default values" $
[r| table T { a: byte = true; } |] `shouldFail` errorMsg
it "with identifier default values" $
[r| table T { a: byte = Red; } |] `shouldFail` errorMsg
describe "with floating point fields" $ do
it "with integer default values" $
[r|
table T {
a: float = 127;
b: float = -32768;
c: float = 1;
d: double = 1.00;
e: double = 2e1;
f: double = 200e-1;
}
|] `shouldValidate`
table ("", TableDecl "T" NotRoot
[ TableField 0 "a" (TFloat 127) False
, TableField 1 "b" (TFloat (-32768)) False
, TableField 2 "c" (TFloat 1) False
, TableField 3 "d" (TDouble 1) False
, TableField 4 "e" (TDouble 20) False
, TableField 5 "f" (TDouble 20) False
]
)
it "with decimal default values" $
[r|
table T {
a: double = 1.1;
b: double = 2e-1;
c: double = 2.22e1;
}
|] `shouldValidate`
table ("", TableDecl "T" NotRoot
[ TableField 0 "a" (TDouble 1.1) False
, TableField 1 "b" (TDouble 0.2) False
, TableField 2 "c" (TDouble 22.2) False
]
)
it "with boolean default values" $
[r| table T { a: double = true; } |] `shouldFail` "[T.a]: default value must be a number"
it "with identifier default values" $
[r| table T { a: double = Red; } |] `shouldFail` "[T.a]: default value must be a number"
describe "with boolean fields" $ do
it "with integer default values" $
[r| table T { a: bool = 1; } |] `shouldFail` "[T.a]: default value must be a boolean"
it "with decimal default values" $
[r| table T { a: bool = 1.1; } |] `shouldFail` "[T.a]: default value must be a boolean"
it "with boolean default values" $
[r|
table T {
a: bool = true;
b: bool = false;
}
|] `shouldValidate`
table ("", TableDecl "T" NotRoot
[ TableField 0 "a" (TBool (DefaultVal True)) False
, TableField 1 "b" (TBool (DefaultVal False)) False
]
)
it "with identifier default values" $
[r| table T { a: bool = Red; } |] `shouldFail` "[T.a]: default value must be a boolean"
describe "with string fields" $ do
it "simple" $
[r| table T { x: string; } |] `shouldValidate`
table ("", TableDecl "T" NotRoot [ TableField 0 "x" (TString Opt) False ])
it "with `required` attribute" $
[r| table T { x: string (required); } |] `shouldValidate`
table ("", TableDecl "T" NotRoot [ TableField 0 "x" (TString Req) False ])
it "with `deprecated` attribute" $
[r| table T { x: string (deprecated); } |] `shouldValidate`
table ("", TableDecl "T" NotRoot [ TableField 0 "x" (TString Opt) True ])
it "with default value" $ do
let errorMsg = "[T.x]: default values currently only supported for scalar fields (integers, floating point, bool, enums)"
[r| table T { x: string = a; } |] `shouldFail` errorMsg
[r| table T { x: string = 0; } |] `shouldFail` errorMsg
[r| table T { x: string = 0.0; } |] `shouldFail` errorMsg
describe "with reference to enum" $ do
it "simple" $
[r|
namespace A.B;
enum E : short { A }
table T {
x: B.E;
}
|] `shouldValidate` foldDecls
[ enum ("A.B", EnumDecl "E" EInt16 [ EnumVal "A" 0 ])
, table ("A.B", TableDecl "T" NotRoot
[ TableField 0 "x" (TEnum (TypeRef "A.B" "E") EInt16 0) False ]
)
]
it "with `required` attribute" $
[r| table T { x: E (required); } enum E : short{A} |] `shouldFail`
"[T.x]: only non-scalar fields (strings, vectors, unions, structs, tables) may be 'required'"
it "with `deprecated` attribute" $
[r| table T { x: E (deprecated); } enum E : short{A} |] `shouldValidate` foldDecls
[ enum ("", EnumDecl "E" EInt16 [ EnumVal "A" 0 ])
, table ("", TableDecl "T" NotRoot
[ TableField 0 "x" (TEnum (TypeRef "" "E") EInt16 0) True ]
)
]
it "without default value, when enum has 0-value" $
[r| table T { x: E; } enum E : short{ A = -1, B = 0, C = 1} |] `shouldValidate` foldDecls
[ enum ("", EnumDecl "E" EInt16 [ EnumVal "A" (-1), EnumVal "B" 0, EnumVal "C" 1 ])
, table ("", TableDecl "T" NotRoot
[ TableField 0 "x" (TEnum (TypeRef "" "E") EInt16 0) False ]
)
]
it "without default value, when enum doesn't have 0-value" $
[r| table T { x: E; } enum E : short{ A = -1, B = 1, C = 2} |] `shouldFail`
"[T.x]: enum does not have a 0 value; please manually specify a default for this field"
describe "with default value" $ do
it "valid integral" $
[r| table T { x: E = 1; } enum E : short{ A, B, C } |] `shouldValidate` foldDecls
[ enum ("", EnumDecl "E" EInt16 [ EnumVal "A" 0, EnumVal "B" 1, EnumVal "C" 2 ])
, table ("", TableDecl "T" NotRoot
[ TableField 0 "x" (TEnum (TypeRef "" "E") EInt16 1) False ]
)
]
it "invalid integral" $
[r| table T { x: E = 3; } enum E : short{ A, B, C } |] `shouldFail`
"[T.x]: default value of 3 is not part of enum E"
it "valid identifier" $
[r| table T { x: E = B; } enum E : short{ A, B, C } |] `shouldValidate` foldDecls
[ enum ("", EnumDecl "E" EInt16 [ EnumVal "A" 0, EnumVal "B" 1, EnumVal "C" 2 ])
, table ("", TableDecl "T" NotRoot
[ TableField 0 "x" (TEnum (TypeRef "" "E") EInt16 1) False ]
)
]
it "invalid identifier" $
[r| table T { x: E = D; } enum E : short{ A, B, C } |] `shouldFail`
"[T.x]: default value of D is not part of enum E"
it "decimal number" $
[r| table T { x: E = 1.5; } enum E : short{ A, B, C } |] `shouldFail`
"[T.x]: default value must be integral or one of: 'A', 'B', 'C'"
it "boolean" $
[r| table T { x: E = 1.5; } enum E : short{ A, B, C } |] `shouldFail`
"[T.x]: default value must be integral or one of: 'A', 'B', 'C'"
describe "with reference to structs/table/union" $ do
it "simple" $
[r|
namespace A;
struct S { x: int; }
table T {}
union U {A.T}
table Table {
x: S;
y: T;
z: U;
}
|] `shouldValidate` foldDecls
[ struct ("A", StructDecl "S" 4 4 [ StructField "x" 0 0 SInt32 ])
, table ("A", TableDecl "T" NotRoot [])
, union ("A", UnionDecl "U" [UnionVal "A_T" (TypeRef "A" "T")])
, table ("A", TableDecl "Table" NotRoot
[ TableField 0 "x" (TStruct (TypeRef "A" "S") Opt) False
, TableField 1 "y" (TTable (TypeRef "A" "T") Opt) False
, TableField 3 "z" (TUnion (TypeRef "A" "U") Opt) False
]
)
]
it "with `required` attribute" $
[r|
namespace A;
struct S { x: int; }
table T {}
union U {A.T}
table Table {
x: S (required);
y: T (required);
z: U (required);
}
|] `shouldValidate` foldDecls
[ struct ("A", StructDecl "S" 4 4 [ StructField "x" 0 0 SInt32 ])
, table ("A", TableDecl "T" NotRoot [])
, union ("A", UnionDecl "U" [UnionVal "A_T" (TypeRef "A" "T")])
, table ("A", TableDecl "Table" NotRoot
[ TableField 0 "x" (TStruct (TypeRef "A" "S") Req) False
, TableField 1 "y" (TTable (TypeRef "A" "T") Req) False
, TableField 3 "z" (TUnion (TypeRef "A" "U") Req) False
]
)
]
it "with `deprecated` attribute" $
[r|
namespace A;
struct S { x: int; }
table T {}
union U {A.T}
table Table {
x: S (deprecated);
y: T (deprecated);
z: U (deprecated);
}
|] `shouldValidate` foldDecls
[ struct ("A", StructDecl "S" 4 4 [ StructField "x" 0 0 SInt32 ])
, table ("A", TableDecl "T" NotRoot [])
, union ("A", UnionDecl "U" [UnionVal "A_T" (TypeRef "A" "T")])
, table ("A", TableDecl "Table" NotRoot
[ TableField 0 "x" (TStruct (TypeRef "A" "S") Opt) True
, TableField 1 "y" (TTable (TypeRef "A" "T") Opt) True
, TableField 3 "z" (TUnion (TypeRef "A" "U") Opt) True
]
)
]
it "with default value" $ do
let errorMsg = "[Table.x]: default values currently only supported for scalar fields (integers, floating point, bool, enums)"
[r| table Table { x: S = 0; } struct S { x: int; } |] `shouldFail` errorMsg
[r| table Table { x: T = 0; } table T{} |] `shouldFail` errorMsg
[r| table Table { x: U = 0; } union U{T} |] `shouldFail` errorMsg
describe "with vector fields" $ do
it "simple" $
[r| table T { x: [string]; y: [int]; z: [bool]; } |] `shouldValidate`
table ("", TableDecl "T" NotRoot
[ TableField 0 "x" (TVector Opt VString) False
, TableField 1 "y" (TVector Opt VInt32) False
, TableField 2 "z" (TVector Opt VBool) False
])
it "where the elements are references" $
[r|
namespace A;
table Table { w: [B.E]; x: [B.S]; y: [B.T]; z: [B.U]; }
namespace A.B;
enum E : int16 { EA }
struct S { x: ubyte; y: int64; }
table T {}
union U { T }
|] `shouldValidate` foldDecls
[ table ("A", TableDecl "Table" NotRoot
[ TableField 0 "w" (TVector Opt (VEnum (TypeRef "A.B" "E") EInt16)) False
, TableField 1 "x" (TVector Opt (VStruct (TypeRef "A.B" "S"))) False
, TableField 2 "y" (TVector Opt (VTable (TypeRef "A.B" "T"))) False
, TableField 4 "z" (TVector Opt (VUnion (TypeRef "A.B" "U"))) False
])
, enum ("A.B", EnumDecl "E" EInt16 [EnumVal "EA" 0])
, struct ("A.B", StructDecl "S" 8 16 [StructField "x" 7 0 SWord8, StructField "y" 0 8 SInt64])
, table ("A.B", TableDecl "T" NotRoot [])
, union ("A.B", UnionDecl "U" [UnionVal "T" (TypeRef "A.B" "T")])
]
it "with `required` attribute" $
[r| table T { x: [byte] (required); } |] `shouldValidate`
table ("", TableDecl "T" NotRoot [ TableField 0 "x" (TVector Req VInt8) False ])
it "with `deprecated` attribute" $
[r| table T { x: [string] (deprecated); } |] `shouldValidate`
table ("", TableDecl "T" NotRoot [ TableField 0 "x" (TVector Opt VString) True ])
it "with default value" $ do
let errorMsg = "[T.x]: default values currently only supported for scalar fields (integers, floating point, bool, enums)"
[r| table T { x: [int] = a; } |] `shouldFail` errorMsg
[r| table T { x: [int] = 0; } |] `shouldFail` errorMsg
[r| table T { x: [int] = 0.0; } |] `shouldFail` errorMsg
describe "with `id` attribute" $ do
it "sorts fields" $
[r|
table T {
w: byte (id: 2);
x: byte (id: 1);
y: byte (id: 3);
z: byte (id: 0);
}
|] `shouldValidate` foldDecls
[ table ("", TableDecl "T" NotRoot
[ TableField 0 "z" (TInt8 0) False
, TableField 1 "x" (TInt8 0) False
, TableField 2 "w" (TInt8 0) False
, TableField 3 "y" (TInt8 0) False
]
)
]
it "id must be skipped when field is a union" $ do
[r|
union U { T }
table T {
x: U (id: 2);
y: byte (id: 3);
z: byte (id: 0);
}
|] `shouldValidate` foldDecls
[ table ("", TableDecl "T" NotRoot
[ TableField 0 "z" (TInt8 0) False
, TableField 2 "x" (TUnion (TypeRef "" "U") Opt) False
, TableField 3 "y" (TInt8 0) False
]
)
, union ("", UnionDecl "U" [UnionVal "T" (TypeRef "" "T")])
]
[r|
union U { T }
table T {
x: U (id: 1);
y: byte (id: 2);
z: byte (id: 0);
}
|] `shouldFail`
"[T.x]: the id of a union field must be the last field's id + 2"
it "id must be skipped when field is a vector of unions" $ do
[r|
union U { T }
table T {
x: [U] (id: 2);
y: byte (id: 3);
z: byte (id: 0);
}
|] `shouldValidate` foldDecls
[ table ("", TableDecl "T" NotRoot
[ TableField 0 "z" (TInt8 0) False
, TableField 2 "x" (TVector Opt (VUnion (TypeRef "" "U"))) False
, TableField 3 "y" (TInt8 0) False
]
)
, union ("", UnionDecl "U" [UnionVal "T" (TypeRef "" "T")])
]
[r|
union U { T }
table T {
x: [U] (id: 1);
y: byte (id: 2);
z: byte (id: 0);
}
|] `shouldFail`
"[T.x]: the id of a vector of unions field must be the last field's id + 2"
it "id can be a string, if it's coercible to an integer" $
[r|
table T {
x: byte (id: "1");
y: byte (id: " 02 ");
z: byte (id: "0");
}
|] `shouldValidate` foldDecls
[ table ("", TableDecl "T" NotRoot
[ TableField 0 "z" (TInt8 0) False
, TableField 1 "x" (TInt8 0) False
, TableField 2 "y" (TInt8 0) False
]
)
]
it "ids cannot be non-integral string" $ do
[r| table T { x: byte (id: "0.3"); } |] `shouldFail` "[T]: expected attribute 'id' to have an integer value, e.g. 'id: 123'"
[r| table T { x: byte (id: "hello"); } |] `shouldFail` "[T]: expected attribute 'id' to have an integer value, e.g. 'id: 123'"
it "when one field has it, all other fields must have it as well" $
[r| table T { x: byte (id: 0); y: int; } |] `shouldFail`
"[T]: either all fields or no fields must have an 'id' attribute"
it "ids must be consecutive" $
[r| table T { x: byte (id: 0); y: int (id: 2); } |] `shouldFail`
"[T.y]: field ids must be consecutive from 0; id 1 is missing"
it "ids must start from 0" $
[r| table T { x: byte (id: 2); y: int (id: 1); } |] `shouldFail`
"[T.y]: field ids must be consecutive from 0; id 0 is missing"
it "can't have duplicate ids" $
[r| table T { x: byte (id: 0); y: int (id: 0); } |] `shouldFail`
"[T.y]: field ids must be consecutive from 0; id 1 is missing"
describe "unions" $ do
it "simple" $
[r|
table T1{}
table T2{}
union U { T1, T2 }
|] `shouldValidate` foldDecls
[ table ("", TableDecl "T1" NotRoot [])
, table ("", TableDecl "T2" NotRoot [])
, union ("", UnionDecl "U"
[ UnionVal "T1" (TypeRef "" "T1")
, UnionVal "T2" (TypeRef "" "T2")
])
]
it "with partially qualified type reference" $
[r|
namespace A.B;
table T1{}
table T2{}
namespace A;
union U { A.B.T1, B.T2 }
|] `shouldValidate` foldDecls
[ table ("A.B", TableDecl "T1" NotRoot [])
, table ("A.B", TableDecl "T2" NotRoot [])
, union ("A", UnionDecl "U"
[ UnionVal "A_B_T1" (TypeRef "A.B" "T1")
, UnionVal "B_T2" (TypeRef "A.B" "T2")
])
]
it "with alias" $
[r|
namespace A.B;
table T1{}
table T2{}
namespace A;
union U { Alias1 : A.B.T1, Alias2:B.T2 }
|] `shouldValidate` foldDecls
[ table ("A.B", TableDecl "T1" NotRoot [])
, table ("A.B", TableDecl "T2" NotRoot [])
, union ("A", UnionDecl "U"
[ UnionVal "Alias1" (TypeRef "A.B" "T1")
, UnionVal "Alias2" (TypeRef "A.B" "T2")
])
]
it "union member must be a valid reference" $
[r| union U { T } |] `shouldFail`
"[U.T]: type 'T' does not exist (checked in these namespaces: '')"
it "union members must be tables" $ do
[r| union U { S } struct S {x: byte;} |] `shouldFail` "[U.S]: union members may only be tables"
[r| union U { U2 } union U2 {T} table T{} |] `shouldFail` "[U.U2]: union members may only be tables"
[r| union U { E } enum E : int {X} |] `shouldFail` "[U.E]: union members may only be tables"
[r| union U { string } |] `shouldFail` "[U.string]: type 'string' does not exist (checked in these namespaces: '')"
it "can't have duplicate identifiers" $ do
[r| table T{} union U {T, T} |] `shouldFail` "[U]: 'T' declared more than once"
[r| namespace A; table T{} union U {A.T, A.T} |] `shouldFail` "[A.U]: 'A_T' declared more than once"
[r| namespace A; table T{} union U {A.T, A_T: T} |] `shouldFail` "[A.U]: 'A_T' declared more than once"
it "can't use NONE as an alias" $
[r| table T{} union U {NONE: T} |] `shouldFail` "[U]: 'NONE' declared more than once"
it "can't refer to a table named NONE" $
[r| table NONE {} union U {NONE} |] `shouldFail` "[U]: 'NONE' declared more than once"
it "can refer to a table named NONE, if using a qualified name" $
[r|
namespace A;
table NONE {}
union U {A.NONE}
|] `shouldValidate` foldDecls
[ table ("A", TableDecl "NONE" NotRoot [])
, union ("A", UnionDecl "U"
[ UnionVal "A_NONE" (TypeRef "A" "NONE")
])
]
it "can refer to a table named NONE, if using an alias" $
[r|
namespace A;
table NONE {}
union U {alias: NONE}
|] `shouldValidate` foldDecls
[ table ("A", TableDecl "NONE" NotRoot [])
, union ("A", UnionDecl "U"
[ UnionVal "alias" (TypeRef "A" "NONE")
])
]
it "can use the same table twice, if using a qualified name" $
[r|
namespace A;
table T{}
union U {T, A.T}
|] `shouldValidate` foldDecls
[ table ("A", TableDecl "T" NotRoot [])
, union ("A", UnionDecl "U"
[ UnionVal "T" (TypeRef "A" "T")
, UnionVal "A_T" (TypeRef "A" "T")
])
]
it "can use the same table twice, if using an alias" $
[r|
namespace A;
table T{}
union U {T, alias:T}
|] `shouldValidate` foldDecls
[ table ("A", TableDecl "T" NotRoot [])
, union ("A", UnionDecl "U"
[ UnionVal "T" (TypeRef "A" "T")
, UnionVal "alias" (TypeRef "A" "T")
])
]
-- -- property: struct size (including paddings) = multiple of alignment
-- -- property: alignment max alignment ???
foldDecls :: [ValidDecls] -> ValidDecls
foldDecls = fold
enum :: (Namespace, EnumDecl) -> ValidDecls
enum e = SymbolTable [e] [] [] []
struct :: (Namespace, StructDecl) -> ValidDecls
struct s = SymbolTable [] [s] [] []
table :: (Namespace, TableDecl) -> ValidDecls
table t = SymbolTable [] [] [t] []
union :: (Namespace, UnionDecl) -> ValidDecls
union u = SymbolTable [] [] [] [u]
shouldSucceed :: HasCallStack => String -> Expectation
shouldSucceed input =
case parse P.schema "" input of
Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e
Right schema ->
let schemas = FileTree "" schema []
in case validateSchemas schemas of
Right _ -> pure ()
Left err -> expectationFailure (T.unpack err)
shouldValidate :: HasCallStack => String -> ValidDecls -> Expectation
shouldValidate input expectation =
case parse P.schema "" input of
Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e
Right schema ->
let schemas = FileTree "" schema []
in validateSchemas schemas `shouldBe` Right (FileTree "" expectation [])
shouldFail :: String -> Text -> Expectation
shouldFail input expectedErrorMsg =
case parse P.schema "" input of
Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e
Right schema ->
let schemas = FileTree "" schema []
in validateSchemas schemas `shouldBe` Left expectedErrorMsg
showBundle :: (ShowErrorComponent e, Stream s) => ParseErrorBundle s e -> String
showBundle = unlines . fmap indent . lines . errorBundlePretty
where
indent x = if null x
then x
else " " ++ x