From 98d25ce51708c361486a76182cc606cc56a560e6 Mon Sep 17 00:00:00 2001 From: Markus Hauck Date: Wed, 6 Jun 2018 20:33:44 +0200 Subject: [PATCH] Change parsers to use `flag'` instead of `switch` This fixes #3959. The problem is that the [switch](https://hackage.haskell.org/package/optparse-applicative/docs/Options-Applicative-Builder.html#v:switch) function returns a `Just False` which gets wrapped into `First`. This means that the value is *always* set to either `True` or `False` and the `First` monoid means that during options parsing the order of the flags suddenly matters as described in #3959, because `First (Just False)` is chosen when `mappend`ing with `First (Just True)`. The fix is to use the [flag](https://hackage.haskell.org/package/optparse-applicative-0.14.2.0/docs/Options-Applicative-Builder.html#v:flag-39-) function that does not set a default value, so we get a `First Nothing` instead. --- src/Stack/Options/BenchParser.hs | 2 +- src/Stack/Options/TestParser.hs | 4 +- .../tests/3959-order-of-flags/Main.hs | 21 ++++++ .../tests/3959-order-of-flags/files/Setup.hs | 2 + .../3959-order-of-flags/files/app/Main.hs | 6 ++ .../3959-order-of-flags/files/bug3959.cabal | 61 +++++++++++++++++ .../3959-order-of-flags/files/src/Lib.hs | 6 ++ .../3959-order-of-flags/files/stack.yaml | 65 +++++++++++++++++++ .../3959-order-of-flags/files/test/Spec.hs | 2 + 9 files changed, 166 insertions(+), 3 deletions(-) create mode 100644 test/integration/tests/3959-order-of-flags/Main.hs create mode 100644 test/integration/tests/3959-order-of-flags/files/Setup.hs create mode 100644 test/integration/tests/3959-order-of-flags/files/app/Main.hs create mode 100644 test/integration/tests/3959-order-of-flags/files/bug3959.cabal create mode 100644 test/integration/tests/3959-order-of-flags/files/src/Lib.hs create mode 100644 test/integration/tests/3959-order-of-flags/files/stack.yaml create mode 100644 test/integration/tests/3959-order-of-flags/files/test/Spec.hs diff --git a/src/Stack/Options/BenchParser.hs b/src/Stack/Options/BenchParser.hs index d25c0a90d3..d5b751c4a2 100644 --- a/src/Stack/Options/BenchParser.hs +++ b/src/Stack/Options/BenchParser.hs @@ -19,7 +19,7 @@ benchOptsParser hide0 = BenchmarkOptsMonoid help ("Forward BENCH_ARGS to the benchmark suite. " <> "Supports templates from `cabal bench`") <> hide)) - <*> optionalFirst (switch (long "no-run-benchmarks" <> + <*> optionalFirst (flag' True (long "no-run-benchmarks" <> help "Disable running of benchmarks. (Benchmarks will still be built.)" <> hide)) where hide = hideMods hide0 diff --git a/src/Stack/Options/TestParser.hs b/src/Stack/Options/TestParser.hs index 08b3b4bf0b..e5c735edd1 100644 --- a/src/Stack/Options/TestParser.hs +++ b/src/Stack/Options/TestParser.hs @@ -27,12 +27,12 @@ testOptsParser hide0 = help "Arguments passed in to the test suite program" <> hide))) <*> optionalFirst - (switch + (flag' True (long "coverage" <> help "Generate a code coverage report" <> hide)) <*> optionalFirst - (switch + (flag' True (long "no-run-tests" <> help "Disable running of tests. (Tests will still be built.)" <> hide)) diff --git a/test/integration/tests/3959-order-of-flags/Main.hs b/test/integration/tests/3959-order-of-flags/Main.hs new file mode 100644 index 0000000000..be74fd1f28 --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/Main.hs @@ -0,0 +1,21 @@ +import StackTest + +import Control.Monad (unless) +import Data.List (isInfixOf) + +-- Integration test for https://github.com/commercialhaskell/stack/issues/3959 +main :: IO () +main = do + checkFlagsBeforeCommand + checkFlagsAfterCommand + +checkFlagsBeforeCommand :: IO () +checkFlagsBeforeCommand = stackCheckStderr ["--nix", "--test", "--no-run-tests", "build"] checker + +checkFlagsAfterCommand :: IO () +checkFlagsAfterCommand = stackCheckStderr ["build", "--nix", "--test", "--no-run-tests"] checker + +checker :: String -> IO () +checker output = do + let testsAreDisabled = any (\ln -> "Test running disabled by" `isInfixOf` ln) (lines output) + unless testsAreDisabled $ fail "Tests should not be run" diff --git a/test/integration/tests/3959-order-of-flags/files/Setup.hs b/test/integration/tests/3959-order-of-flags/files/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/files/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/integration/tests/3959-order-of-flags/files/app/Main.hs b/test/integration/tests/3959-order-of-flags/files/app/Main.hs new file mode 100644 index 0000000000..de1c1ab35c --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/files/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = someFunc diff --git a/test/integration/tests/3959-order-of-flags/files/bug3959.cabal b/test/integration/tests/3959-order-of-flags/files/bug3959.cabal new file mode 100644 index 0000000000..dc899c9b31 --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/files/bug3959.cabal @@ -0,0 +1,61 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: bb372c89031f8c68e9e26d37362cb59adb7915eb2da6333d56da87a83966bb35 + +name: bug3959 +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/bug3959#readme +bug-reports: https://github.com/githubuser/bug3959/issues +author: Author name here +maintainer: example@example.com +copyright: 2018 Author name here +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/githubuser/bug3959 + +library + exposed-modules: + Lib + other-modules: + Paths_bug3959 + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 + +executable bug3959-exe + main-is: Main.hs + other-modules: + Paths_bug3959 + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , bug3959 + default-language: Haskell2010 + +test-suite bug3959-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_bug3959 + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , bug3959 + default-language: Haskell2010 diff --git a/test/integration/tests/3959-order-of-flags/files/src/Lib.hs b/test/integration/tests/3959-order-of-flags/files/src/Lib.hs new file mode 100644 index 0000000000..d36ff2714d --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/files/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/integration/tests/3959-order-of-flags/files/stack.yaml b/test/integration/tests/3959-order-of-flags/files/stack.yaml new file mode 100644 index 0000000000..a9e6a04c31 --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/files/stack.yaml @@ -0,0 +1,65 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-11.12 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor \ No newline at end of file diff --git a/test/integration/tests/3959-order-of-flags/files/test/Spec.hs b/test/integration/tests/3959-order-of-flags/files/test/Spec.hs new file mode 100644 index 0000000000..cd4753fc9c --- /dev/null +++ b/test/integration/tests/3959-order-of-flags/files/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"