mirror of
https://github.com/anoma/juvix.git
synced 2025-01-07 16:22:14 +03:00
2f4a3f809b
## Overview
This PR makes the compiler pipeline thread-safe so that the test suite
can be run in parallel.
This is achieved by:
* Removing use of `{get, set, with}CurrentDir` functions.
* Adding locking around shared file resources like the the
global-project and internal build directory.
NB: **Locking is disabled for the main compiler target**, as it is
single threaded they are not required.
## Run test suite in parallel
To run the test suite in parallel you must add `--ta '+RTS -N -RTS'` to
your stack test arguments. For example:
```
stack test --fast --ta '+RTS -N -RTS'
```
The `-N` instructs the Haskell runtime to choose the number of threads
to use based on how many processors there are on your machine. You can
use `-Nn` to see the number of threads to `n`.
These flags are already [set in the
Makefile](e6dca22cfd/Makefile (L26))
when you or CI uses `stack test`.
## Locking
The Haskell package
[filelock](https://hackage.haskell.org/package/filelock) is used for
locking. File locks are used instead of MVars because Juvix code does
not control when new threads are created, they are created by the test
suite. This means that MVars created by Juvix code will have no effect,
because they are created independently on each test-suite thread.
Additionally the resources we're locking live on the filesystem and so
can be conveniently tagged by path.
### FileLock
The filelock library is wrapped in a FileLock effect:
e6dca22cfd/src/Juvix/Data/Effect/FileLock/Base.hs (L6-L8)
There is an [IO
interpreter](e6dca22cfd/src/Juvix/Data/Effect/FileLock/IO.hs (L8))
that uses filelock and an [no-op
interpreter](e6dca22cfd/src/Juvix/Data/Effect/FileLock/Permissive.hs (L7))
that just runs actions unconditionally.
### TaggedLock
To make the file locks simpler to use a TaggedLock effect is introduced:
e6dca22cfd/src/Juvix/Data/Effect/TaggedLock/Base.hs (L5-L11)
And convenience function:
e6dca22cfd/src/Juvix/Data/Effect/TaggedLock.hs (L28)
This allows an action to be locked, tagged by a directory that may or
may not exist. For example in the following code, an action is performed
on a directory `root` that may delete the directory before repopulating
the files. So the lockfile cannot be stored in the `root` itself.
e6dca22cfd/src/Juvix/Extra/Files.hs (L55-L60)
## Pipeline
As noted above, we only use locking in the test suite. The main app
target pipeline is single threaded and so locking is unnecessary. So the
interpretation of locks is parameterised so that locking can be disabled
e6dca22cfd/src/Juvix/Compiler/Pipeline/Run.hs (L64)
289 lines
8.4 KiB
Haskell
289 lines
8.4 KiB
Haskell
module Typecheck.Negative where
|
|
|
|
import Base
|
|
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error
|
|
import Juvix.Data.Effect.TaggedLock
|
|
|
|
type FailMsg = String
|
|
|
|
data NegTest = NegTest
|
|
{ _name :: String,
|
|
_relDir :: Path Rel Dir,
|
|
_file :: Path Rel File,
|
|
_checkErr :: TypeCheckerError -> Maybe FailMsg
|
|
}
|
|
|
|
testDescr :: NegTest -> TestDescr
|
|
testDescr NegTest {..} =
|
|
let tRoot = root <//> _relDir
|
|
file' = tRoot <//> _file
|
|
in TestDescr
|
|
{ _testName = _name,
|
|
_testRoot = tRoot,
|
|
_testAssertion = Single $ do
|
|
entryPoint <- defaultEntryPointIO' LockModeExclusive tRoot file'
|
|
result <- runIOEither' LockModeExclusive entryPoint upToInternalTyped
|
|
case mapLeft fromJuvixError result of
|
|
Left (Just tyError) -> whenJust (_checkErr tyError) assertFailure
|
|
Left Nothing -> assertFailure "An error ocurred but it was not in the type checker."
|
|
Right _ -> assertFailure "The type checker did not find an error."
|
|
}
|
|
|
|
allTests :: TestTree
|
|
allTests =
|
|
testGroup
|
|
"Typecheck negative tests"
|
|
[ testGroup
|
|
"General typechecking errors"
|
|
(map (mkTest . testDescr) tests),
|
|
testGroup
|
|
"Non-strictly positive data types"
|
|
(map (mkTest . testDescr) negPositivityTests)
|
|
]
|
|
|
|
root :: Path Abs Dir
|
|
root = relToProject $(mkRelDir "tests/negative")
|
|
|
|
wrongError :: Maybe FailMsg
|
|
wrongError = Just "Incorrect error"
|
|
|
|
tests :: [NegTest]
|
|
tests =
|
|
[ NegTest
|
|
"Constructor in pattern type error"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "PatternConstructor.juvix")
|
|
$ \case
|
|
ErrWrongConstructorType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Check pattern with hole type"
|
|
$(mkRelDir "265")
|
|
$(mkRelFile "M.juvix")
|
|
$ \case
|
|
ErrWrongConstructorType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Type vs inferred type mismatch"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "WrongType.juvix")
|
|
$ \case
|
|
ErrWrongType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Function application with non-function type"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "ExpectedFunctionType.juvix")
|
|
$ \case
|
|
ErrExpectedFunctionType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Unsolved hole"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "UnsolvedMeta.juvix")
|
|
$ \case
|
|
ErrUnsolvedMeta {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Multiple type errors are captured"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "MultiWrongType.juvix")
|
|
$ \case
|
|
ErrWrongType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Unexpected braces in pattern"
|
|
$(mkRelDir "issue1337")
|
|
$(mkRelFile "Braces.juvix")
|
|
$ \case
|
|
ErrArity (ErrWrongPatternIsImplicit {}) -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Unexpected double braces in pattern"
|
|
$(mkRelDir "issue1337")
|
|
$(mkRelFile "DoubleBraces.juvix")
|
|
$ \case
|
|
ErrArity (ErrWrongPatternIsImplicit {}) -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Wrong return type name for a constructor of a simple data type"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "WrongReturnType.juvix")
|
|
$ \case
|
|
ErrWrongReturnType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Too few arguments for the return type of a constructor"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "WrongReturnTypeTooFewArguments.juvix")
|
|
$ \case
|
|
ErrWrongType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous hole"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "IdenFunctionArgsNoExplicit.juvix")
|
|
$ \case
|
|
ErrUnsolvedMeta {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Cycle in hole"
|
|
$(mkRelDir "issue1700")
|
|
$(mkRelFile "SelfApplication.juvix")
|
|
$ \case
|
|
ErrUnsolvedMeta {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Negative integer literal cannot be used as a Nat"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "LiteralInteger.juvix")
|
|
$ \case
|
|
ErrNoInstance {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Integer literal cannot be used as a String"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "LiteralIntegerString.juvix")
|
|
$ \case
|
|
ErrNoInstance {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Unsupported type function"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "UnsupportedTypeFunction.juvix")
|
|
$ \case
|
|
ErrUnsupportedTypeFunction {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Instance target not a trait"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "TargetNotATrait.juvix")
|
|
$ \case
|
|
ErrTargetNotATrait {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Not a trait"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "NotATrait.juvix")
|
|
$ \case
|
|
ErrNotATrait {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"No instance"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "NoInstance.juvix")
|
|
$ \case
|
|
ErrNoInstance {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous instances"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "AmbiguousInstances.juvix")
|
|
$ \case
|
|
ErrAmbiguousInstances {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Subsumed instance"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "SubsumedInstance.juvix")
|
|
$ \case
|
|
ErrSubsumedInstance {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Explicit instance argument"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "ExplicitInstanceArgument.juvix")
|
|
$ \case
|
|
ErrExplicitInstanceArgument {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Instance termination"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "InstanceTermination.juvix")
|
|
$ \case
|
|
ErrTraitNotTerminating {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Default value wrong type"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "DefaultTypeError.juvix")
|
|
$ \case
|
|
ErrWrongType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Coercion target not a trait"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "CoercionTargetNotATrait.juvix")
|
|
$ \case
|
|
ErrTargetNotATrait {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Invalid coercion type"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "InvalidCoercionType.juvix")
|
|
$ \case
|
|
ErrInvalidCoercionType {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Wrong coercion argument"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "WrongCoercionArgument.juvix")
|
|
$ \case
|
|
ErrWrongCoercionArgument {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Ambiguous coercions"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "AmbiguousCoercions.juvix")
|
|
$ \case
|
|
ErrAmbiguousInstances {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest
|
|
"Coercion cycles"
|
|
$(mkRelDir "Internal")
|
|
$(mkRelFile "LoopingCoercion.juvix")
|
|
$ \case
|
|
ErrCoercionCycles {} -> Nothing
|
|
_ -> wrongError
|
|
]
|
|
|
|
negPositivityTests :: [NegTest]
|
|
negPositivityTests =
|
|
[ NegTest "E1" $(mkRelDir "Internal/Positivity") $(mkRelFile "E1.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E2" $(mkRelDir "Internal/Positivity") $(mkRelFile "E2.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E3" $(mkRelDir "Internal/Positivity") $(mkRelFile "E3.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E4" $(mkRelDir "Internal/Positivity") $(mkRelFile "E4.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E5" $(mkRelDir "Internal/Positivity") $(mkRelFile "E5.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E6" $(mkRelDir "Internal/Positivity") $(mkRelFile "E6.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E7" $(mkRelDir "Internal/Positivity") $(mkRelFile "E7.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E8" $(mkRelDir "Internal/Positivity") $(mkRelFile "E8.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError,
|
|
NegTest "E9" $(mkRelDir "Internal/Positivity") $(mkRelFile "E9.juvix") $
|
|
\case
|
|
ErrNoPositivity {} -> Nothing
|
|
_ -> wrongError
|
|
]
|