Skip to content
Snippets Groups Projects
Commit 6e54b235 authored by Matthew Pickering's avatar Matthew Pickering Committed by Mikolaj Konarski
Browse files

Add test for duplicate environment variables when invoking testsuite

Adds a simple test case that identifies and reports duplicate
environment variables in the Cabal environment.

For issue (#10718)
parent 4375dd5f
No related branches found
No related tags found
No related merge requests found
packages: p
import Test.Cabal.Prelude
main = cabalTest $ recordMode DoNotRecord $ do
res <- cabal' "test" ["all"]
assertOutputContains "No duplicate environment variables found" res
module Main where
import Data.List (group, sort)
import System.Environment (getEnvironment)
main = do
env <- getEnvironment
let sortedEnv = sort env
duplicates = filter (\g -> length g > 1) $ group $ map fst sortedEnv
if null duplicates
then putStrLn "No duplicate environment variables found."
else do
putStrLn "Found duplicate environment variables:"
mapM_ (\d -> putStrLn $ " - " ++ head d) duplicates
fail "Test failed due to duplicate environment variables"
cabal-version: 3.0
name: p
version: 0.1.0.0
build-type: Simple
test-suite env-test
default-language: Haskell2010
type: exitcode-stdio-1.0
main-is: Main.hs
build-depends: base
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment