Merge pull request purescript#1323 from hdgarrood/should-fail-with

paf31 · paf31 · commit 464af8e3c2e4 · 2015-08-02T17:24:46.000-07:00
Check the right kind of error is thrown in tests
diff --git a/examples/failing/365.purs b/examples/failing/365.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInDeclaration
 module Main where
 
 import Prelude
diff --git a/examples/failing/438.purs b/examples/failing/438.purs
@@ -1,11 +1,15 @@
+-- @shouldFailWith NoInstanceFound
+
+-- See issue 438 for details: this test is mainly here to test that code like
+-- this doesn't cause the compiler to loop.
+
 module Main where
 
 import Prelude
 
 data Fix f = In (f (Fix f))
 
 instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where
-  (==) (In f) (In g) = f == g
-  (/=) a b = not (a == b)
+  eq (In f) (In g) = f == g
 
 example = In [] == In []
diff --git a/examples/failing/ArrayType.purs b/examples/failing/ArrayType.purs
@@ -1,3 +1,5 @@
+-- @shouldFailWith TypesDoNotUnify
+
 module Main where
 
 import Prelude
diff --git a/examples/failing/Arrays.purs b/examples/failing/Arrays.purs
@@ -1,5 +1,8 @@
+-- @shouldFailWith ExprDoesNotHaveType
 module Main where
 
 import Prelude
 
+foreign import (!!) :: forall a. Array a -> Int -> a
+
 test = \arr -> arr !! (0 !! 0)
diff --git a/examples/failing/CaseDoesNotMatchAllConstructorArgs.purs b/examples/failing/CaseDoesNotMatchAllConstructorArgs.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith IncorrectConstructorArity
 module Main where
 
 import Prelude
diff --git a/examples/failing/Do.purs b/examples/failing/Do.purs
@@ -1,3 +1,5 @@
+-- @shouldFailWith InvalidDoBind
+-- @shouldFailWith InvalidDoLet
 module Main where
 
 import Prelude
diff --git a/examples/failing/DoNotSuggestComposition.purs b/examples/failing/DoNotSuggestComposition.purs
@@ -1,3 +1,6 @@
+-- @shouldFailWith TypesDoNotUnify
+-- TODO: Check that this does not produce a "function composition is (<<<)"
+-- suggestion.
 module DoNotSuggestComposition where
 
 import Prelude
diff --git a/examples/failing/DoNotSuggestComposition2.purs b/examples/failing/DoNotSuggestComposition2.purs
@@ -1,3 +1,7 @@
+-- @shouldFailWith CannotApplyFunction
+-- TODO: Check that this does not produce a "function composition is (<<<)"
+-- suggestion.
+
 module DoNotSuggestComposition2 where
 
 foo = let x = { y: 3 } in x 2
diff --git a/examples/failing/DuplicateDeclarationsInLet.purs b/examples/failing/DuplicateDeclarationsInLet.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith OverlappingNamesInLet
 module Main where
 
 import Prelude
diff --git a/examples/failing/DuplicateProperties1.purs b/examples/failing/DuplicateProperties1.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TypesDoNotUnify
 module DuplicateProperties where
 
 import Prelude
diff --git a/examples/failing/DuplicateProperties2.purs b/examples/failing/DuplicateProperties2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith DuplicateLabel
 module DuplicateProperties where
 
 import Prelude
diff --git a/examples/failing/DuplicateTypeVars.purs b/examples/failing/DuplicateTypeVars.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith DuplicateTypeArgument
 module Main where
 
 import Prelude
diff --git a/examples/failing/Eff.purs b/examples/failing/Eff.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TypesDoNotUnify
 module Main where
 
 import Prelude
diff --git a/examples/failing/ExtraRecordField.purs b/examples/failing/ExtraRecordField.purs
@@ -1,4 +1,5 @@
-
+-- @shouldFailWith PropertyIsMissing
+-- TODO: Make this fail with a new error ExtraProperty instead.
 module ExtraRecordField where
 
 import Prelude ((<>))
diff --git a/examples/failing/Foldable.purs b/examples/failing/Foldable.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInDeclaration
 module Main where
 
 import Prelude
diff --git a/examples/failing/InstanceExport.purs b/examples/failing/InstanceExport.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TransitiveExportError
 module InstanceExport (S(..), f) where
 
 import Prelude
@@ -13,5 +14,6 @@ instance fs :: F S where
 module Test where
 
 import InstanceExport
+import Prelude
 
 test = f $ S "Test"
diff --git a/examples/failing/KindError.purs b/examples/failing/KindError.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith KindsDoNotUnify
 module Main where
 
 import Prelude
diff --git a/examples/failing/LeadingZeros1.purs b/examples/failing/LeadingZeros1.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module Main where
 
 import Prelude
diff --git a/examples/failing/LeadingZeros2.purs b/examples/failing/LeadingZeros2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module Main where
 
 import Prelude
diff --git a/examples/failing/Let.purs b/examples/failing/Let.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInDeclaration
 module Main where
 
 import Prelude
diff --git a/examples/failing/MPTCs.purs b/examples/failing/MPTCs.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith KindsDoNotUnify
 module Main where
 
 import Prelude
diff --git a/examples/failing/MissingClassExport.purs b/examples/failing/MissingClassExport.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TransitiveExportError
 module Test (bar) where
 
 import Prelude
diff --git a/examples/failing/MissingClassMemberExport.purs b/examples/failing/MissingClassMemberExport.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TransitiveExportError
 module Test (Foo) where
 
 import Prelude
diff --git a/examples/failing/MissingRecordField.purs b/examples/failing/MissingRecordField.purs
@@ -1,4 +1,5 @@
-
+-- @shouldFailWith TypesDoNotUnify
+-- TODO: Update type checker to make this fail with PropertyIsMissing instead. 
 module MissingRecordField where
 
 import Prelude ((>))
diff --git a/examples/failing/MultipleErrors.purs b/examples/failing/MultipleErrors.purs
@@ -1,11 +1,13 @@
+-- @shouldFailWith ExprDoesNotHaveType
+-- @shouldFailWith ExprDoesNotHaveType
 module MultipleErrors where
 
 import Prelude
 
-foo :: Number -> Number
+foo :: Int -> Int
 foo 0 = "Test"
 foo n = bar (n - 1)
 
-bar :: Number -> Number
+bar :: Int -> Int
 bar 0 = "Test"
 bar n = foo (n - 1)
diff --git a/examples/failing/MultipleErrors2.purs b/examples/failing/MultipleErrors2.purs
@@ -1,3 +1,5 @@
+-- @shouldFailWith UnknownValue
+-- @shouldFailWith UnknownValue
 module MultipleErrors2 where
 
 import Prelude
diff --git a/examples/failing/MutRec.purs b/examples/failing/MutRec.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInDeclaration
 module MutRec where
 
 import Prelude
diff --git a/examples/failing/MutRec2.purs b/examples/failing/MutRec2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInDeclaration
 module Main where
 
 import Prelude
diff --git a/examples/failing/NewtypeMultiArgs.purs b/examples/failing/NewtypeMultiArgs.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith InvalidNewtype
 module Main where
 
 import Prelude
diff --git a/examples/failing/NewtypeMultiCtor.purs b/examples/failing/NewtypeMultiCtor.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith InvalidNewtype
 module Main where
 
 import Prelude
diff --git a/examples/failing/NoOverlap.purs b/examples/failing/NoOverlap.purs
diff --git a/examples/failing/NullaryAbs.purs b/examples/failing/NullaryAbs.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module Main where
 
 import Prelude
diff --git a/examples/failing/Object.purs b/examples/failing/Object.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith PropertyIsMissing
 module Main where
 
 import Prelude
diff --git a/examples/failing/OverlappingArguments.purs b/examples/failing/OverlappingArguments.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith OverlappingArgNames
 module OverlappingArguments where
 
 import Prelude
diff --git a/examples/failing/OverlappingBinders.purs b/examples/failing/OverlappingBinders.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith OverlappingArgNames
 module OverlappingBinders where
 
 import Prelude
diff --git a/examples/failing/OverlappingInstances.purs b/examples/failing/OverlappingInstances.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith OverlappingInstances
 module OverlappingInstances where
 
 import Prelude
diff --git a/examples/failing/OverlappingInstances2.purs b/examples/failing/OverlappingInstances2.purs
@@ -1,18 +1,17 @@
+-- @shouldFailWith OverlappingInstances
 module OverlappingInstances where
 
 import Prelude
 
 data A = A | B
 
 instance eqA1 :: Eq A where
-  (==) A A = true
-  (==) B B = true
-  (==) _ _ = false
-  (/=) x y = not (x == y)
+  eq A A = true
+  eq B B = true
+  eq _ _ = false
 
 instance eqA2 :: Eq A where
-  (==) _ _ = true
-  (/=) _ _ = false
+  eq _ _ = true
 
 instance ordA :: Ord A where
   compare A B = LT
diff --git a/examples/failing/OverlappingVars.purs b/examples/failing/OverlappingVars.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith NoInstanceFound
 module Main where
 
 import Prelude
diff --git a/examples/failing/Rank2Types.purs b/examples/failing/Rank2Types.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ExprDoesNotHaveType
 module Main where
 
 import Prelude
diff --git a/examples/failing/Reserved.purs b/examples/failing/Reserved.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module Main where
 
 import Prelude
diff --git a/examples/failing/RowConstructors1.purs b/examples/failing/RowConstructors1.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith KindsDoNotUnify
 module Main where
 
 import Prelude
diff --git a/examples/failing/RowConstructors2.purs b/examples/failing/RowConstructors2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith KindsDoNotUnify
 module Main where
 
 import Prelude
diff --git a/examples/failing/RowConstructors3.purs b/examples/failing/RowConstructors3.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith KindsDoNotUnify
 module Main where
 
 import Prelude
diff --git a/examples/failing/SkolemEscape.purs b/examples/failing/SkolemEscape.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith EscapedSkolem
 module Main where
 
 import Prelude
diff --git a/examples/failing/SkolemEscape2.purs b/examples/failing/SkolemEscape2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith EscapedSkolem
 module Main where
 
 import Prelude
diff --git a/examples/failing/SuggestComposition.purs b/examples/failing/SuggestComposition.purs
@@ -1,3 +1,5 @@
+-- @shouldFailWith TypesDoNotUnify
+-- TODO: Ensure the correct suggestion is produced.
 module SuggestComposition where
 
 import Prelude
diff --git a/examples/failing/Superclasses1.purs b/examples/failing/Superclasses1.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith NoInstanceFound
 module Main where
 
 import Prelude
diff --git a/examples/failing/Superclasses2.purs b/examples/failing/Superclasses2.purs
@@ -1,3 +1,5 @@
+-- @shouldFailWith CycleInTypeSynonym
+-- TODO: Should this have its own error, perhaps CycleInTypeClassDeclaration?
 module CycleInSuperclasses where
 
 import Prelude
diff --git a/examples/failing/Superclasses3.purs b/examples/failing/Superclasses3.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith UndefinedTypeVariable
 module UnknownSuperclassTypeVar where
 
 import Prelude
diff --git a/examples/failing/Superclasses4.purs b/examples/failing/Superclasses4.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith OverlappingInstances
 module OverlappingInstances where
 
 import Prelude
@@ -11,4 +12,4 @@ instance foo2 :: Foo Number
 test :: forall a. (Foo a) => a -> a
 test a = a
 
-test1 = test 0
+test1 = test 0.0
diff --git a/examples/failing/TopLevelCaseNoArgs.purs b/examples/failing/TopLevelCaseNoArgs.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith DuplicateValueDeclaration
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeClassInstances.purs b/examples/failing/TypeClassInstances.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith MissingClassMember
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeClasses2.purs b/examples/failing/TypeClasses2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith NoInstanceFound
 module Main where
 
 import Prelude ()
diff --git a/examples/failing/TypeError.purs b/examples/failing/TypeError.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ExprDoesNotHaveType
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeSynonyms.purs b/examples/failing/TypeSynonyms.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInTypeSynonym
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeSynonyms2.purs b/examples/failing/TypeSynonyms2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TypeSynonymInstance
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeSynonyms3.purs b/examples/failing/TypeSynonyms3.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith TypeSynonymInstance
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeSynonyms4.purs b/examples/failing/TypeSynonyms4.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith PartiallyAppliedSynonym
 module TypeSynonyms4 where
 
 import Prelude
diff --git a/examples/failing/TypeSynonyms5.purs b/examples/failing/TypeSynonyms5.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith CycleInTypeSynonym
 module Main where
 
 import Prelude
diff --git a/examples/failing/TypeWildcards1.purs b/examples/failing/TypeWildcards1.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module TypeWildcards where
 
 import Prelude
diff --git a/examples/failing/TypeWildcards2.purs b/examples/failing/TypeWildcards2.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module TypeWildcards where
 
 import Prelude
diff --git a/examples/failing/TypeWildcards3.purs b/examples/failing/TypeWildcards3.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module TypeWildcards where
 
 import Prelude
diff --git a/examples/failing/UnderscoreModuleName.purs b/examples/failing/UnderscoreModuleName.purs
@@ -1,3 +1,4 @@
+-- @shouldFailWith ErrorParsingModule
 module Bad_Module where
 
 import Prelude
diff --git a/examples/failing/UnifyInTypeInstanceLookup.purs b/examples/failing/UnifyInTypeInstanceLookup.purs
diff --git a/examples/failing/UnknownType.purs b/examples/failing/UnknownType.purs
diff --git a/tests/Main.hs b/tests/Main.hs

Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,4 @@`
	`1`	`+-- @shouldFailWith CycleInDeclaration`
`1`	`2`	`module Main where`
`2`	`3`
`3`	`4`	`import Prelude`
Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,5 @@`
	`1`	`+-- @shouldFailWith TypesDoNotUnify`
	`2`	`+`
`1`	`3`	`module Main where`
`2`	`4`
`3`	`5`	`import Prelude`
Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,4 @@`
	`1`	`+-- @shouldFailWith IncorrectConstructorArity`
`1`	`2`	`module Main where`
`2`	`3`
`3`	`4`	`import Prelude`
Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,5 @@`
	`1`	`+-- @shouldFailWith InvalidDoBind`
	`2`	`+-- @shouldFailWith InvalidDoLet`
`1`	`3`	`module Main where`
`2`	`4`
`3`	`5`	`import Prelude`
Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,4 @@`
	`1`	`+-- @shouldFailWith OverlappingNamesInLet`
`1`	`2`	`module Main where`
`2`	`3`
`3`	`4`	`import Prelude`
Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,4 @@`
	`1`	`+-- @shouldFailWith TypesDoNotUnify`
`1`	`2`	`module DuplicateProperties where`
`2`	`3`
`3`	`4`	`import Prelude`