diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,28 @@ +2026-07-07 + * Version bump (4.8). (#745) + +2026-05-07 + * Version bump (4.7.1). (#730) + +2026-03-07 + * Version bump (4.7). (#714) + * Raise error when compiling empty arrays or structs. (#695) + +2026-01-07 + * Version bump (4.6.1). (#705) + +2025-11-07 + * Version bump (4.6). (#679) + +2025-09-07 + * Version bump (4.5.1). (#666) + +2025-07-07 + * Version bump (4.5). (#642) + +2025-05-07 + * Version bump (4.4). (#618) + 2025-03-07 * Version bump (4.3). (#604) diff --git a/copilot-c99.cabal b/copilot-c99.cabal --- a/copilot-c99.cabal +++ b/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.3 +version : 4.8 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.3 && < 4.4 + , copilot-core >= 4.8 && < 4.9 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/src/Copilot/Compile/C99/Error.hs b/src/Copilot/Compile/C99/Error.hs --- a/src/Copilot/Compile/C99/Error.hs +++ b/src/Copilot/Compile/C99/Error.hs @@ -5,7 +5,10 @@ -- -- Custom functions to report error messages to users. module Copilot.Compile.C99.Error - ( impossible ) + ( impossible + , errorEmptyStruct + , errorZeroLengthArray + ) where -- | Report an error due to a bug in Copilot. @@ -18,3 +21,17 @@ ++ ". Please file an issue at " ++ "https://github.com/Copilot-Language/copilot/issues" ++ " or email the maintainers at " + +-- | Report an error when attempting to compile a zero-length array to C99. +-- C99 does not support zero-length arrays, so Copilot cannot compile +-- specifications that use them. +errorZeroLengthArray :: a +errorZeroLengthArray = + error "copilot-c99: Cannot compile zero-length arrays to C99.\n" + +-- | Report an error when attempting to compile an empty struct to C99. +-- C99 does not support empty structs, so Copilot cannot compile +-- specifications that use them. +errorEmptyStruct :: a +errorEmptyStruct = + error "copilot-c99: Cannot compile empty structs to C99.\n" diff --git a/src/Copilot/Compile/C99/Expr.hs b/src/Copilot/Compile/C99/Expr.hs --- a/src/Copilot/Compile/C99/Expr.hs +++ b/src/Copilot/Compile/C99/Expr.hs @@ -18,7 +18,7 @@ arrayElems, toValues, typeLength, typeSize ) -- Internal imports -import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.Error ( impossible, errorEmptyStruct, errorZeroLengthArray ) import Copilot.Compile.C99.Name ( exCpyName, streamAccessorName ) import Copilot.Compile.C99.Type ( transLocalVarDeclType, transType, transTypeName ) @@ -371,14 +371,23 @@ -- | Transform a Copilot Struct, based on the struct fields, into a list of C99 -- initializer values. +-- +-- Raises an error if the struct is empty, as C99 does not support structs with +-- no fields. constStruct :: [Value a] -> NonEmpty.NonEmpty C.InitItem -constStruct val = NonEmpty.fromList $ map constFieldInit val +constStruct val = case val of + [] -> errorEmptyStruct + _ -> NonEmpty.fromList $ map constFieldInit val -- | Transform a Copilot Array, based on the element values and their type, -- into a list of C99 initializer values. +-- +-- Raises an error if the array is empty, as C99 does not support zero-length +-- arrays. constArray :: Type a -> [a] -> NonEmpty.NonEmpty C.InitItem -constArray ty = - NonEmpty.fromList . map (C.InitItem Nothing . constInit ty) +constArray ty xs = case xs of + [] -> errorZeroLengthArray + _ -> NonEmpty.fromList $ map (C.InitItem Nothing . constInit ty) xs -- | Explicitly cast a C99 value to a type. explicitTy :: Type a -> C.Expr -> C.Expr diff --git a/src/Copilot/Compile/C99/Type.hs b/src/Copilot/Compile/C99/Type.hs --- a/src/Copilot/Compile/C99/Type.hs +++ b/src/Copilot/Compile/C99/Type.hs @@ -12,7 +12,9 @@ import qualified Language.C99.Simple as C -- Internal imports: Copilot -import Copilot.Core ( Type (..), typeLength, typeName ) +import Copilot.Core ( Struct (..), Type (..), typeLength, + typeName ) +import Copilot.Compile.C99.Error ( errorEmptyStruct, errorZeroLengthArray ) -- | Translate a Copilot type to a C99 type. transType :: Type a -> C.Type @@ -28,10 +30,12 @@ Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" Float -> C.TypeSpec C.Float Double -> C.TypeSpec C.Double - Array ty' -> C.Array (transType ty') len + Array ty' | typeLength ty == 0 -> errorZeroLengthArray + | otherwise -> C.Array (transType ty') len where len = Just $ C.LitInt $ fromIntegral $ typeLength ty - Struct s -> C.TypeSpec $ C.Struct (typeName s) + Struct s | null (toValues s) -> errorEmptyStruct + | otherwise -> C.TypeSpec $ C.Struct (typeName s) -- | Translate a Copilot type to a valid (local) variable declaration C99 type. -- diff --git a/tests/Test/Copilot/Compile/C99.hs b/tests/Test/Copilot/Compile/C99.hs --- a/tests/Test/Copilot/Compile/C99.hs +++ b/tests/Test/Copilot/Compile/C99.hs @@ -8,10 +8,11 @@ -- External imports import Control.Arrow ((&&&)) -import Control.Exception (IOException, catch) -import Control.Monad (when) +import Control.Exception (ErrorCall (..), IOException, catch, + try) +import Control.Monad (unless, when) import Data.Bits (Bits, complement) -import Data.List (intercalate) +import Data.List (intercalate, isSubsequenceOf) import Data.Type.Equality (testEquality) import Data.Typeable (Proxy (..), (:~:) (Refl)) import GHC.TypeLits (KnownNat, natVal) @@ -24,7 +25,9 @@ import System.Process (callProcess, readProcess) import System.Random (Random) import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit (Assertion, assertFailure) import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary, choose, elements, forAll, forAllBlind, frequency, @@ -50,6 +53,7 @@ , testProperty "Compile specification in custom dir" testCompileCustomDir , testProperty "Run specification" testRun , testProperty "Run and compare results" testRunCompare + , testCase "Reject empty arrays and structs" testRejectEmpties ] -- * Individual tests @@ -136,6 +140,65 @@ guard = Const Bool True args = [] + +data Empty = Empty + +instance Struct Empty where + typeName _ = "" + toValues _ = [] + +instance Typed Empty where + typeOf = Struct Empty + +-- | Test that compiling a spec with an empty array or struct raises an error. +-- C99 does not support zero-length arrays or structs without fields, so Copilot +-- should report an error during compilation. +testRejectEmpties :: Assertion +testRejectEmpties = do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + r1 <- try (compile "copilot_test" $ spec t1) :: IO (Either ErrorCall ()) + unless (isErrZeroArray r1) $ assertFailure "Const zero-length array" + + r2 <- try (compile "copilot_test" $ spec t2) :: IO (Either ErrorCall ()) + unless (isErrZeroArray r2) $ assertFailure "Extern zero-length array" + + r3 <- try (compile "copilot_test" $ spec t3) :: IO (Either ErrorCall ()) + unless (isErrEmptyStruct r3) $ assertFailure "Const empty struct" + + r4 <- try (compile "copilot_test" $ spec t4) :: IO (Either ErrorCall ()) + unless (isErrEmptyStruct r4) $ assertFailure "Extern empty struct" + + where + + spec a = Spec streams observers (triggers a) properties + + streams = [] + observers = [] + triggers a = [ Trigger "trig" (Const Bool True) a ] + properties = [] + + t1 = [ UExpr arrTy (Const arrTy (array [])) ] + t2 = [ UExpr arrTy (ExternVar arrTy "arrs" Nothing) ] + t3 = [ UExpr structTy (Const structTy Empty) ] + t4 = [ UExpr structTy (ExternVar structTy "structs" Nothing) ] + + arrTy :: Type (Array 0 Bool) + arrTy = Array Bool + + structTy :: Type Empty + structTy = Struct Empty + + isErrZeroArray :: Either ErrorCall a -> Bool + isErrZeroArray e = case e of + Left (ErrorCall msg) -> "zero-length array" `isSubsequenceOf` msg + _ -> False + + isErrEmptyStruct :: Either ErrorCall a -> Bool + isErrEmptyStruct e = case e of + Left (ErrorCall msg) -> "empty struct" `isSubsequenceOf` msg + _ -> False -- | Test compiling a spec and running the resulting program. --