InternalSpec.hs

{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE DeriveGeneric       #-}
{-#LANGUAGE DataKinds           #-}
{-#LANGUAGE GADTs               #-}
module Foreign.Storable.Generic.InternalSpec where


-- Test tools
import Test.Hspec
import Test.QuickCheck
import GenericType 

-- Tested modules
import Foreign.Storable.Generic.Internal 

-- Additional data
import Foreign.Storable.Generic.Tools
import Foreign.Storable.Generic.Instances
import GHC.Generics
import Foreign.Marshal.Alloc (malloc, mallocBytes, free)
import Foreign.Marshal.Array (peekArray, pokeArray)
import Foreign.Ptr (Ptr, plusPtr)
import Data.Word



spec :: Spec
spec = do 
    describe "internalSizeOf" $ do
        it "is equal to: calcSize $ zip (glistSizeOf' a) (glistAlignment' a)" $ do
            property (\((NestedToType (GenericType val)) :: NestedToType 4) -> 
                internalSizeOf val `shouldBe` (calcSize $ zip (glistSizeOf' val) (glistAlignment' val) ) )
    describe "internalAlignment" $ do
        it "is equal to: maximum (glistAlignment' a)" $ do
            property (\((NestedToType (GenericType val)) :: NestedToType 4) -> 
                internalAlignment val `shouldBe` (maximum $ glistAlignment' val) )
    describe "internalOffsets" $ do
        it "is equal to: calcOffsets $ zip (glistSizeOf' a) (glistAlignment' a)" $ do
            property (\((NestedToType (GenericType val)) :: NestedToType 4) -> 
                internalOffsets val `shouldBe` (calcOffsets $ zip (glistSizeOf' val) (glistAlignment' val) ) )
    describe "internalPeekByteOff" $ do
        it "is equal to: gpeekByteOff' (internalOffsets a) ptr off" $ do
            property (\((NestedToType (GenericType (val :: f p))) :: NestedToType 4) -> do
                let size      = internalSizeOf val
                    no_fields = gnumberOf' (undefined :: f p)
                off <- generate $ suchThat arbitrary (\x -> x>=0 && x < 100)
                
                -- Area in memory to peek
                bytes <- generate $ ok_vector (off + size)
                ptr <- mallocBytes (off + size)
                pokeArray ptr bytes
                
                -- first peek
                v1 <- internalPeekByteOff ptr off :: IO (f p)
                v2 <- gpeekByteOff' (internalOffsets val) (no_fields - 1) ptr off :: IO (f p)
                
                free ptr
                v1 `shouldBe` v2
                )
        it "it reads only specified area of the memory" $ do
            property $ (\((NestedToType (GenericType (test_type1 :: f p))) :: NestedToType 4) -> do    
                let size      = internalSizeOf test_type1 
                    pokeBytes = pokeArray :: (Ptr Word8 -> [Word8] -> IO ())
                -- The memory area
                ptr <- mallocBytes (size+16)
                
                -- Beginning state.
                bytes1_beginning <- generate $ ok_vector 8
                bytes1_middle    <- generate $ ok_vector size
                bytes1_end       <- generate $ ok_vector 8
                
                pokeBytes  ptr                   bytes1_beginning
                pokeBytes (plusPtr ptr 8)        bytes1_middle
                pokeBytes (plusPtr ptr (size+8)) bytes1_end
            
                v1 <- internalPeekByteOff ptr 8 :: IO (f p)
                
                -- Changed state 
                bytes2_beginning <- generate $ suchThat (ok_vector 8) (/=bytes1_beginning)
                bytes2_end       <- generate $ suchThat (ok_vector 8) (/=bytes1_end)
                
                pokeBytes  ptr               bytes2_beginning
                pokeBytes (plusPtr ptr (size + 8)) bytes2_end
                
                v2 <- internalPeekByteOff ptr 8 :: IO (f p) 
 
                v1 `shouldBe` v2
                )
    describe "internalPokeByteOff" $ do
        it "is equal to: gpokeByteOff' (internalOffsets a) ptr off v" $ do
            property (\((NestedToType (GenericType (val :: f p))) :: NestedToType 4)  -> do
                let size = internalSizeOf val
                    no_fields = gnumberOf' (undefined :: f p)
                off <- generate $ suchThat arbitrary (\x -> x>=0 && x < 100)
                
                -- Area in memory to poke
                ptr <- mallocBytes (off + size)
                
                -- first poke
                internalPokeByteOff ptr off val
                bytes1 <- peekArray (off + size) ptr :: IO [Word8]
                
                -- second poke
                gpokeByteOff' (internalOffsets val) (no_fields - 1) ptr off val
                bytes2 <- peekArray (off + size) ptr :: IO [Word8]
 
                free ptr
                
                bytes1 `shouldBe` bytes2
                )
        it "it modifies only specified area of the memory" $ do
            property $ (\((NestedToType (GenericType test_type1)) ::NestedToType 4)-> do    
                test_type2 <- generate $ suchThat arbitrary (/=test_type1)
                -- if test_type1 is different from test_type2, then 
                -- the memory state has to change when poking both of them
                let size = internalSizeOf test_type1 
                    peekBytes = peekArray :: (Int -> Ptr Word8 -> IO [Word8])
                -- The memory area
                ptr <- mallocBytes (size+16)
               
                -- Beginning state.
                mem_state1_beginning <- peekBytes 8     ptr                   
                mem_state1_middle    <- peekBytes size (plusPtr ptr 8)              
                mem_state1_end       <- peekBytes 8    (plusPtr ptr (size+8))
            
                internalPokeByteOff ptr 8 test_type1
                -- Poked first variable
                mem_state2_beginning <- peekBytes 8     ptr
                mem_state2_middle    <- peekBytes size (plusPtr ptr 8)
                mem_state2_end       <- peekBytes 8    (plusPtr ptr (size+8))
            
                internalPokeByteOff ptr 8 test_type2
                -- Poked second state
                mem_state3_beginning <- peekBytes 8     ptr
                mem_state3_middle    <- peekBytes size (plusPtr ptr 8)
                mem_state3_end       <- peekBytes 8    (plusPtr ptr (size+8))
                
  
                -- Beginnings and ends should stay the same. The middle one should be different from
                -- the one at the beginning.
                sequence_ [mem_state1_beginning `shouldBe` mem_state2_beginning
                          ,mem_state2_beginning `shouldBe` mem_state3_beginning
                          ,mem_state1_end       `shouldBe` mem_state2_end                  
                          ,mem_state2_end       `shouldBe` mem_state3_end
                          ,(mem_state1_middle /= mem_state2_middle) || (mem_state1_middle /= mem_state3_middle) `shouldBe` True]
                )
    describe "other" $ do
        it "poke, then peek: receive the poked value" $ do
            property $ (\((NestedToType (GenericType (val :: f p) )) :: NestedToType 4) -> do
                let size = internalSizeOf val
                off <- generate $ suchThat arbitrary (\x -> x>=0 && x < 100)
                
                ptr <- mallocBytes (size + off)

                internalPokeByteOff ptr off val
                p_val <- internalPeekByteOff ptr off :: IO (f p) 
                val `shouldBe` p_val
                )