diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 049700fb..9209a7ef 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20240708 +# version: 0.19.20241111 # -# REGENDATA ("0.19.20240708",["github","language-c.cabal"]) +# REGENDATA ("0.19.20241111",["github","language-c.cabal"]) # name: Haskell-CI on: @@ -28,6 +28,11 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.12.0.20241031 + compilerKind: ghc + compilerVersion: 9.12.0.20241031 + setup-method: ghcup-prerelease + allow-failure: false - compiler: ghc-9.10.1 compilerKind: ghc compilerVersion: 9.10.1 @@ -73,57 +78,86 @@ jobs: compilerVersion: 8.6.5 setup-method: ghcup allow-failure: false - - compiler: ghc-8.4.4 - compilerKind: ghc - compilerVersion: 8.4.4 - setup-method: ghcup - allow-failure: false - compiler: ghc-8.2.2 compilerKind: ghc compilerVersion: 8.2.2 - setup-method: ghcup + setup-method: hvr-ppa allow-failure: false - compiler: ghc-8.0.2 compilerKind: ghc compilerVersion: 8.0.2 - setup-method: ghcup + setup-method: hvr-ppa allow-failure: false fail-fast: false steps: - - name: apt + - name: apt-get install run: | apt-get update - apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 + - name: Install GHCup + run: | mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + - name: Install cabal-install + run: | "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + - name: Install GHC (hvr-ppa) + if: matrix.setup-method == 'hvr-ppa' + run: | + apt-add-repository -y 'ppa:hvr/ghc' + apt-get update + apt-get install -y "$HCNAME" + HC=$HCDIR/bin/$HCKIND + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" + echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} HCVER: ${{ matrix.compilerVersion }} - - name: Set PATH and environment variables + - name: Install GHC (GHCup) + if: matrix.setup-method == 'ghcup' run: | - echo "$HOME/.cabal/bin" >> $GITHUB_PATH - echo "LANG=C.UTF-8" >> "$GITHUB_ENV" - echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" - echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" - HCDIR=/opt/$HCKIND/$HCVER + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: Install GHC (GHCup prerelease) + if: matrix.setup-method == 'ghcup-prerelease' + run: | + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: Set PATH and environment variables + run: | + echo "$HOME/.cabal/bin" >> $GITHUB_PATH + echo "LANG=C.UTF-8" >> "$GITHUB_ENV" + echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" + echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" - echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -150,6 +184,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(language-c)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -239,8 +288,8 @@ jobs: rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - name: save cache - uses: actions/cache/save@v4 if: always() + uses: actions/cache/save@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store diff --git a/ChangeLog.md b/ChangeLog.md index 40a4fad4..70956c6a 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -4,6 +4,7 @@ - Support for half-precision floating point `__fp16`, `_Float16`, and `_Float16x`. - Support for bfloat16 `__bf16`. +- Support alignment specifies `_Alignas` in struct declatations. ## 0.9.4 diff --git a/language-c.cabal b/language-c.cabal index ee0b9e6f..c313e6bf 100644 --- a/language-c.cabal +++ b/language-c.cabal @@ -7,16 +7,15 @@ copyright: LICENSE maintainer: language.c@monoid.al author: AUTHORS tested-with: - ghc ==9.10.1 - ghc ==9.8.2 ghc ==9.6.6 ghc ==9.4.8 ghc ==9.2.8 ghc ==9.0.2 - ghc ==8.10.7 ghc ==8.8.4 ghc ==8.6.5 ghc ==8.4.4 ghc ==8.2.2 - ghc ==8.0.2 + ghc ==9.12.1 ghc ==9.10.1 ghc ==9.8.2 ghc ==9.6.6 ghc ==9.4.8 + ghc ==9.2.8 ghc ==9.0.2 ghc ==8.10.7 ghc ==8.8.4 ghc ==8.6.5 + ghc ==8.4.4 ghc ==8.2.2 ghc ==8.0.2 homepage: https://visq.github.io/language-c/ bug-reports: https://github.com/visq/language-c/issues/ synopsis: Analysis and generation of C code description: - Language C is a haskell library for the analysis and generation of C code. + Language C is a Haskell library for the analysis and generation of C code. It features a complete, well tested parser and pretty printer for all of C99 and a large set of C11 and clang/GNU extensions. @@ -34,11 +33,14 @@ source-repository head flag usebytestrings description: Use ByteString as InputStream datatype + manual: True flag iecfpextension description: Support IEC 60559 floating point extension (defines _Float128) + manual: True + library exposed-modules: Language.C @@ -91,6 +93,7 @@ library ExistentialQuantification GeneralizedNewtypeDeriving ScopedTypeVariables + ghc-options: -Wall -Wno-redundant-constraints build-depends: base >=4.9 && <5, array <0.6, @@ -102,8 +105,6 @@ library pretty <1.2.0, process <1.7 - ghc-options: -Wall -Wno-redundant-constraints - if flag(usebytestrings) build-depends: bytestring >=0.9.0 && <0.13 diff --git a/src/Language/C/Data/InputStream.hs b/src/Language/C/Data/InputStream.hs index 32499e92..4c070321 100644 --- a/src/Language/C/Data/InputStream.hs +++ b/src/Language/C/Data/InputStream.hs @@ -71,16 +71,13 @@ type InputStream = ByteString takeByte bs = BSW.head bs `seq` (BSW.head bs, BSW.tail bs) takeChar bs = BSC.head bs `seq` (BSC.head bs, BSC.tail bs) inputStreamEmpty = BSW.null -#ifndef __HADDOCK__ -takeChars !n bstr = BSC.unpack $ BSC.take n bstr --leaks -#endif +takeChars !n bstr = BSC.unpack $ BSC.take n bstr readInputStream = BSW.readFile inputStreamToString = BSC.unpack inputStreamFromString = BSC.pack countLines = length . BSC.lines - #else type InputStream = String diff --git a/test/src/Language/C/Test/Framework.hs b/test/src/Language/C/Test/Framework.hs index b5573e15..185ec8d0 100644 --- a/test/src/Language/C/Test/Framework.hs +++ b/test/src/Language/C/Test/Framework.hs @@ -26,7 +26,6 @@ module Language.C.Test.Measures, ) where -import Control.Monad.Except import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map diff --git a/test/src/Language/C/Test/TestMonad.hs b/test/src/Language/C/Test/TestMonad.hs index a8976b21..5597497c 100644 --- a/test/src/Language/C/Test/TestMonad.hs +++ b/test/src/Language/C/Test/TestMonad.hs @@ -30,6 +30,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, local, ask) import Control.Monad.State (MonadState, StateT, execStateT, put, get, modify, gets) import Data.Map (elems) +import Prelude hiding (Applicative(..)) import System.CPUTime import System.Directory import System.Environment (getArgs) diff --git a/test/src/RenderTests.hs b/test/src/RenderTests.hs index f8c7feb1..d8b5b25a 100644 --- a/test/src/RenderTests.hs +++ b/test/src/RenderTests.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -XPatternGuards #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : RenderTests.hs (executable) @@ -19,11 +19,11 @@ -- TODO: Sort the tests. The tablesorter javascript doesn't play nice with the browser's back-button ----------------------------------------------------------------------------- module Main (main) where + import Control.Monad import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map -import Data.List import System.IO import System.Directory (getCurrentDirectory) @@ -37,7 +37,7 @@ import Language.C.Test.Framework -- | read the dat file containing the test-results readTestRuns :: FilePath -> IO [TestRun] -readTestRuns = liftM (map read . lines) . readFile +readTestRuns = fmap (map read . lines) . readFile -- Summarize a set of test runs data TestSetResult = TestSetResult @@ -72,10 +72,7 @@ data TestSummary = TestSummary deriving (Show,Read) throughput :: TestSummary -> Double -throughput ts = (totalEntities ts) `per` (totalTime ts) - -numTests :: TestSummary -> Int -numTests s = numOk s + numFailed s +throughput ts = totalEntities ts `per` totalTime ts initSummary :: Test -> TestSummary initSummary t = TestSummary { sTestInfo = t, numOk = 0, numFailed = 0, totalEntities = 0, totalTime = 0 } @@ -100,7 +97,7 @@ updateSetSummary (TestResults _obj _files results) s = addToSummary :: TestResult -> Map String TestSummary -> Map String TestSummary addToSummary (TestResult testinfo _ teststatus) sums - | (isTestError teststatus) = sums + | isTestError teststatus = sums | otherwise = Map.alter alterSummary (testName testinfo) sums where alterSummary Nothing = alterSummary (Just (initSummary testinfo)) @@ -126,7 +123,7 @@ indexFile :: String indexFile = "index.html" testSetFile :: TestSetResult -> String -testSetFile tss = (testSetName tss) ++ ".html" +testSetFile tss = testSetName tss ++ ".html" -- ==================== -- = main entry point = -- ==================== @@ -139,7 +136,7 @@ main = do exitWith (ExitFailure 1) (parserVersion : _tests) <- getArgs let tests = map takeBaseName _tests - testruns <- liftM (zip tests) $ mapM (readTestRuns.datFile) tests + testruns <- fmap (zip tests) $ mapM (readTestRuns.datFile) tests -- make file references relative to the current directory (for publishing) pwd <- getCurrentDirectory let normalizeFilePath = makeRelative pwd . normalise' @@ -148,7 +145,7 @@ main = do let testresults = map (uncurry computeSummary) testruns -- export index file writeFile indexFile $ - htmlFile ("Test result overviews") $ + htmlFile "Test result overviews" $ indexContents parserVersion testresults -- export detailed file forM_ testresults $ \testResult -> @@ -171,7 +168,7 @@ indexContents parserVersion tsresults = ["test set name","total tests", "init error", "fatal error", "tests run", "all tests ok", "some tests failed" ] (map overviewRow results) (overviewSummaryRow results) - overviewRow tsr = (testSetLink tsr) : + overviewRow tsr = testSetLink tsr : map (toHtml.show) [totalTestRuns tsr, initErrors tsr, fatalErrors tsr, executedTests tsr, allOk tsr, someFailed tsr ] overviewSummaryRow rs = stringToHtml "Total" : @@ -180,7 +177,7 @@ indexContents parserVersion tsresults = sumMap f = sum . map f testSetLink tsr = (anchor << testSetName tsr) ! [href (testSetFile tsr)] testSummary tsr = - h3 << (testSetLink tsr) + h3 << testSetLink tsr +++ summaryView tsr -- | create testset.html @@ -200,14 +197,14 @@ detailedContents normRef tsr = mkTable :: (HTML hd) => [hd] -> [[Html]] -> Html mkTable tableHeader tableRows = table $ - thead << (tr << (map (th <<) tableHeader)) - +++ tbody << (concatHtml $ map (tr . concatHtml . map td) tableRows) + thead << (tr << map (th <<) tableHeader) + +++ tbody << concatHtml (map (tr . concatHtml . map td) tableRows) mkTableWithSummaryRow :: (HTML hd, HTML lst) => [hd] -> [[Html]] -> [lst] -> Html mkTableWithSummaryRow tableHeader tableRows tableLast = table $ - thead << (tr << (map (th <<) tableHeader)) - +++ tbody << (concatHtml $ map (tr . concatHtml . map td) tableRows) + thead << (tr << map (th <<) tableHeader) + +++ tbody << concatHtml (map (tr . concatHtml . map td) tableRows) +++ tr (concatHtml $ map (\c -> (td << c) ! [ theclass "last_row" ]) tableLast) tablesorterImport :: [String] -> Html @@ -268,36 +265,36 @@ summaryTable summaries = mkTable tblHeader (map mkRow summaries) -- create HTML for detailled view detailedView :: (FilePath -> FilePath) -> TestSetResult -> Html detailedView normRef tsr = - h1 (toHtml$ "Detailed Report") + h1 (toHtml "Detailed Report") +++ detailedTable (Set.toList allKeys) (testRuns tsr) ! [ identifier "reportTable", theclass "tablesorter" ] where allKeys = Set.fromList . map (testName . sTestInfo) . Map.elems . testSummaries $ tsr detailedTable testkeys runs = table $ - (thead << (detailedHeader ("Test Objective" : "Input Files" : testkeys))) - +++ (tbody << (aboves $ map (detailedRow testkeys) runs)) + (thead << detailedHeader ("Test Objective" : "Input Files" : testkeys)) + +++ (tbody << aboves (map (detailedRow testkeys) runs)) detailedHeader testkeys = besides $ map (th <<) testkeys - detailedRow _testkeys (FatalError msg args) = cell$ (td fatalErr) ! [ theclass "fatal_error" ] + detailedRow _testkeys (FatalError msg args) = cell$ td fatalErr ! [ theclass "fatal_error" ] where - fatalErr = (toHtml $ "Fatal Error: "++show args ) + fatalErr = toHtml ("Fatal Error: "++show args) +++ thediv (linesToHtml $ lines msg) ! [ theclass "errmsg_box" ] - detailedRow _testkeys (InitFailure msg args) = cell$ (td initError) ! [ theclass "init_error" ] + detailedRow _testkeys (InitFailure msg args) = cell$ td initError ! [ theclass "init_error" ] where - initError = (toHtml $ "Fatal Initialization Error on " ++ show args) + initError = toHtml ("Fatal Initialization Error on " ++ show args) +++ thediv (linesToHtml $ lines msg) ! [ theclass "errmsg_box" ] detailedRow testkeys (TestResults testobject filesUnderTest results) = - (cell $ td << testobject) - `beside` (filesCell filesUnderTest) - `beside` (besides $ map (detailedCell results) testkeys) + cell (td << testobject) + `beside` filesCell filesUnderTest + `beside` besides (map (detailedCell results) testkeys) filesCell :: [FilePath] -> HtmlTable filesCell = cell . td . concatHtml . map fileref where fileref fp = (anchor << takeFileName fp) ! [href $ normRef fp] +++ br - detailedCell :: (Map.Map String TestResult) -> String -> HtmlTable + detailedCell :: Map.Map String TestResult -> String -> HtmlTable detailedCell results key = cell$ case Map.lookup key results of Nothing -> td (toHtml "n/a") ! [ theclass "not_avail"] @@ -313,7 +310,7 @@ detailedView normRef tsr = failureCell errMsg Nothing = toHtml $ "Failure: "++errMsg okCell :: Maybe PerfMeasure -> Maybe FilePath -> Html - okCell measure mReport = addRef mReport "Ok " +++ (measureInfo measure) ! [ theclass "time_info" ] + okCell measure mReport = addRef mReport "Ok " +++ measureInfo measure ! [ theclass "time_info" ] where addRef Nothing info = toHtml info addRef (Just f) info = (anchor << info) ! [href $ normRef f] measureInfo Nothing = noHtml @@ -326,5 +323,5 @@ normalise' :: FilePath -> FilePath normalise' = joinPath . reverse . foldl removeDotDot [] . splitPath . normalise where removeDotDot (dircomp:ds) dotDot | dropTrailingPathSeparator dotDot == "..", not (isAbsolute dircomp) = ds - removeDotDot (dircomp:ds) dot | dropTrailingPathSeparator dot == "." = (dircomp:ds) + removeDotDot (dircomp:ds) dot | dropTrailingPathSeparator dot == "." = dircomp:ds removeDotDot ds c = c:ds