From 9a3798e71501e452892224558cb908b0e286a2f1 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 27 Jan 1999 15:01:17 +0000
Subject: [PATCH] [project @ 1999-01-27 15:01:03 by simonpj] Haskell 98 updates
---
ghc/tests/array/should_run/arr001.hs | 2 +-
ghc/tests/array/should_run/arr002.hs | 2 +-
ghc/tests/array/should_run/arr003.hs | 2 +-
ghc/tests/array/should_run/arr004.hs | 2 +-
ghc/tests/array/should_run/arr005.hs | 2 +-
ghc/tests/array/should_run/arr006.hs | 2 +-
ghc/tests/array/should_run/arr007.hs | 2 +-
ghc/tests/array/should_run/arr008.hs | 2 +-
ghc/tests/array/should_run/arr009.hs | 2 +-
ghc/tests/array/should_run/arr010.hs | 2 +-
ghc/tests/array/should_run/arr011.hs | 2 +-
ghc/tests/array/should_run/arr012.hs | 2 +-
ghc/tests/array/should_run/arr014.hs | 2 +-
ghc/tests/ccall/should_compile/cc001.hs | 2 +-
ghc/tests/ccall/should_compile/cc002.hs | 2 +-
ghc/tests/ccall/should_compile/cc003.hs | 4 +-
ghc/tests/ccall/should_compile/cc006.hs | 2 +-
ghc/tests/ccall/should_fail/cc001.hs | 2 +-
ghc/tests/ccall/should_fail/cc002.hs | 2 +-
ghc/tests/ccall/should_fail/cc004.hs | 2 +-
ghc/tests/deriving/should_compile/drv001.hs | 2 +-
ghc/tests/deriving/should_compile/drv003.hs | 2 +-
ghc/tests/deriving/should_compile/drv004.hs | 2 +-
ghc/tests/deriving/should_compile/drv005.hs | 2 +-
ghc/tests/deriving/should_compile/drv006.hs | 2 +-
ghc/tests/deriving/should_compile/drv007.hs | 2 +-
ghc/tests/deriving/should_compile/drv008.hs | 2 +-
ghc/tests/deriving/should_compile/drv009.hs | 2 +-
ghc/tests/deriving/should_compile/drv010.hs | 2 +-
ghc/tests/deriving/should_fail/drvfail004.hs | 2 +-
ghc/tests/deriving/should_fail/drvfail007.hs | 2 +-
ghc/tests/typecheck/should_run/tcrun004.hs | 72 ++++++++++++++++++++
32 files changed, 104 insertions(+), 32 deletions(-)
create mode 100644 ghc/tests/typecheck/should_run/tcrun004.hs
diff --git a/ghc/tests/array/should_run/arr001.hs b/ghc/tests/array/should_run/arr001.hs
index 1e42f1979677..d45d7b8d31f5 100644
--- a/ghc/tests/array/should_run/arr001.hs
+++ b/ghc/tests/array/should_run/arr001.hs
@@ -1,4 +1,4 @@
---!!! Simple array creation
+-- !!! Simple array creation
import Array
diff --git a/ghc/tests/array/should_run/arr002.hs b/ghc/tests/array/should_run/arr002.hs
index 67c5d82b86aa..56505d643795 100644
--- a/ghc/tests/array/should_run/arr002.hs
+++ b/ghc/tests/array/should_run/arr002.hs
@@ -1,4 +1,4 @@
---!!! Array creation, (index,value) list with duplicates.
+-- !!! Array creation, (index,value) list with duplicates.
--
-- Haskell library report 1.3 (and earlier) specifies
-- that `array' values created with lists containing dups,
diff --git a/ghc/tests/array/should_run/arr003.hs b/ghc/tests/array/should_run/arr003.hs
index 06faa313d0f5..14a99214ebb6 100644
--- a/ghc/tests/array/should_run/arr003.hs
+++ b/ghc/tests/array/should_run/arr003.hs
@@ -1,4 +1,4 @@
---!!! Array creation, (index,value) list with out of bound index.
+-- !!! Array creation, (index,value) list with out of bound index.
--
-- Haskell library report 1.3 (and earlier) specifies
-- that `array' values created with lists containing out-of-bounds indices,
diff --git a/ghc/tests/array/should_run/arr004.hs b/ghc/tests/array/should_run/arr004.hs
index f7537d69288a..cc54395c27fe 100644
--- a/ghc/tests/array/should_run/arr004.hs
+++ b/ghc/tests/array/should_run/arr004.hs
@@ -1,4 +1,4 @@
---!!! Array - accessing undefined element
+-- !!! Array - accessing undefined element
--
-- Sample Haskell implementation in the 1.3 Lib report defines
-- this as being undefined/error.
diff --git a/ghc/tests/array/should_run/arr005.hs b/ghc/tests/array/should_run/arr005.hs
index 84e4a7615744..62ed12c72e79 100644
--- a/ghc/tests/array/should_run/arr005.hs
+++ b/ghc/tests/array/should_run/arr005.hs
@@ -1,4 +1,4 @@
---!!! Array - recurrences
+-- !!! Array - recurrences
--
-- array does not evaluate the elements.
--
diff --git a/ghc/tests/array/should_run/arr006.hs b/ghc/tests/array/should_run/arr006.hs
index ff2c561be0e1..8aa1ddd36872 100644
--- a/ghc/tests/array/should_run/arr006.hs
+++ b/ghc/tests/array/should_run/arr006.hs
@@ -1,4 +1,4 @@
---!!! Array - empty arrays
+-- !!! Array - empty arrays
--
-- print a couple of them to try to expose empty arrays
-- to a GC or two.
diff --git a/ghc/tests/array/should_run/arr007.hs b/ghc/tests/array/should_run/arr007.hs
index 2a4d9aece84d..ec0c98376c47 100644
--- a/ghc/tests/array/should_run/arr007.hs
+++ b/ghc/tests/array/should_run/arr007.hs
@@ -1,4 +1,4 @@
---!!! Array - accessing empty arrays
+-- !!! Array - accessing empty arrays
--
-- empty arrays are legal, but indexing them is undefined!
--
diff --git a/ghc/tests/array/should_run/arr008.hs b/ghc/tests/array/should_run/arr008.hs
index 6b0729275928..30d79a6044d5 100644
--- a/ghc/tests/array/should_run/arr008.hs
+++ b/ghc/tests/array/should_run/arr008.hs
@@ -1,4 +1,4 @@
---!!! Array - out-of-range (index,value) pairs
+-- !!! Array - out-of-range (index,value) pairs
--
-- supplying a list containing one or more pairs
-- with out-of-range index is undefined.
diff --git a/ghc/tests/array/should_run/arr009.hs b/ghc/tests/array/should_run/arr009.hs
index ad9f0a6c2784..b45e9e39a317 100644
--- a/ghc/tests/array/should_run/arr009.hs
+++ b/ghc/tests/array/should_run/arr009.hs
@@ -1,4 +1,4 @@
---!!! Array - derived ops
+-- !!! Array - derived ops
--
-- testing the well-behavedness of
-- derived ops for empty and non-empty arrays
diff --git a/ghc/tests/array/should_run/arr010.hs b/ghc/tests/array/should_run/arr010.hs
index ead7d65d252c..94bf8f3fca2b 100644
--- a/ghc/tests/array/should_run/arr010.hs
+++ b/ghc/tests/array/should_run/arr010.hs
@@ -1,4 +1,4 @@
---!!! Array - accumulated arrays
+-- !!! Array - accumulated arrays
--
--
module Main(main) where
diff --git a/ghc/tests/array/should_run/arr011.hs b/ghc/tests/array/should_run/arr011.hs
index fca26f9d5000..f4a95d191080 100644
--- a/ghc/tests/array/should_run/arr011.hs
+++ b/ghc/tests/array/should_run/arr011.hs
@@ -1,4 +1,4 @@
---!!! Array - array difference operator
+-- !!! Array - array difference operator
--
--
module Main(main) where
diff --git a/ghc/tests/array/should_run/arr012.hs b/ghc/tests/array/should_run/arr012.hs
index 98da45efd029..e0ed3a9d49d2 100644
--- a/ghc/tests/array/should_run/arr012.hs
+++ b/ghc/tests/array/should_run/arr012.hs
@@ -1,4 +1,4 @@
---!!! Array map operations
+-- !!! Array map operations
--
--
module Main(main) where
diff --git a/ghc/tests/array/should_run/arr014.hs b/ghc/tests/array/should_run/arr014.hs
index 86996a10d164..7efb1b5aa381 100644
--- a/ghc/tests/array/should_run/arr014.hs
+++ b/ghc/tests/array/should_run/arr014.hs
@@ -1,6 +1,6 @@
{-# OPTIONS -fglasgow-exts #-}
---!!! multi-dimensional arrays
+-- !!! multi-dimensional arrays
module Main ( main ) where
import GlaExts
diff --git a/ghc/tests/ccall/should_compile/cc001.hs b/ghc/tests/ccall/should_compile/cc001.hs
index 465a4332d573..2c93e8a50ac3 100644
--- a/ghc/tests/ccall/should_compile/cc001.hs
+++ b/ghc/tests/ccall/should_compile/cc001.hs
@@ -1,4 +1,4 @@
---!!! cc001 -- ccall with standard boxed arguments and results
+-- !!! cc001 -- ccall with standard boxed arguments and results
module ShouldCompile where
diff --git a/ghc/tests/ccall/should_compile/cc002.hs b/ghc/tests/ccall/should_compile/cc002.hs
index d3ed1f15db94..48880c6f8793 100644
--- a/ghc/tests/ccall/should_compile/cc002.hs
+++ b/ghc/tests/ccall/should_compile/cc002.hs
@@ -1,4 +1,4 @@
---!!! cc002 -- ccall with ambiguous result (should be defaulted to ())
+-- !!! cc002 -- ccall with ambiguous result (should be defaulted to ())
module ShouldCompile where
a :: IO ()
diff --git a/ghc/tests/ccall/should_compile/cc003.hs b/ghc/tests/ccall/should_compile/cc003.hs
index a3dbf78b5835..4ac4c824a2c8 100644
--- a/ghc/tests/ccall/should_compile/cc003.hs
+++ b/ghc/tests/ccall/should_compile/cc003.hs
@@ -1,5 +1,5 @@
---!!! cc003 -- ccall with unresolved polymorphism (should fail)
---!!! not anymore (as of 0.29, result type will default to ())
+-- !!! cc003 -- ccall with unresolved polymorphism (should fail)
+-- !!! not anymore (as of 0.29, result type will default to ())
module ShouldCompile where
fubar :: IO Int
diff --git a/ghc/tests/ccall/should_compile/cc006.hs b/ghc/tests/ccall/should_compile/cc006.hs
index 488491f9165c..374010792b24 100644
--- a/ghc/tests/ccall/should_compile/cc006.hs
+++ b/ghc/tests/ccall/should_compile/cc006.hs
@@ -1,4 +1,4 @@
---!!! cc006 -- ccall with non-standard boxed arguments and results
+-- !!! cc006 -- ccall with non-standard boxed arguments and results
module Test where
diff --git a/ghc/tests/ccall/should_fail/cc001.hs b/ghc/tests/ccall/should_fail/cc001.hs
index f0dd58c8ff75..4019f6178219 100644
--- a/ghc/tests/ccall/should_fail/cc001.hs
+++ b/ghc/tests/ccall/should_fail/cc001.hs
@@ -1,4 +1,4 @@
---!!! cc002 -- ccall with ambiguous argument
+-- !!! cc002 -- ccall with ambiguous argument
module Test where
f :: IO ()
diff --git a/ghc/tests/ccall/should_fail/cc002.hs b/ghc/tests/ccall/should_fail/cc002.hs
index 7dbbf7297e6d..36d6a7769189 100644
--- a/ghc/tests/ccall/should_fail/cc002.hs
+++ b/ghc/tests/ccall/should_fail/cc002.hs
@@ -1,4 +1,4 @@
---!!! cc002 -- ccall with non-standard boxed arguments and results
+-- !!! cc002 -- ccall with non-standard boxed arguments and results
module Test where
diff --git a/ghc/tests/ccall/should_fail/cc004.hs b/ghc/tests/ccall/should_fail/cc004.hs
index eded2ff65c92..6f7207f97963 100644
--- a/ghc/tests/ccall/should_fail/cc004.hs
+++ b/ghc/tests/ccall/should_fail/cc004.hs
@@ -1,4 +1,4 @@
---!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
+-- !!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
module Test where
-- Since I messed up the handling of polymorphism originally, I'll
diff --git a/ghc/tests/deriving/should_compile/drv001.hs b/ghc/tests/deriving/should_compile/drv001.hs
index ffe8196c8f71..694af6a50f9c 100644
--- a/ghc/tests/deriving/should_compile/drv001.hs
+++ b/ghc/tests/deriving/should_compile/drv001.hs
@@ -1,4 +1,4 @@
---!!! canonical weird example for "deriving"
+-- !!! canonical weird example for "deriving"
module ShouldSucceed where
data X a b
diff --git a/ghc/tests/deriving/should_compile/drv003.hs b/ghc/tests/deriving/should_compile/drv003.hs
index f6d678006a63..0b8149ce8a09 100644
--- a/ghc/tests/deriving/should_compile/drv003.hs
+++ b/ghc/tests/deriving/should_compile/drv003.hs
@@ -1,4 +1,4 @@
---!!! This is the example given in TcDeriv
+-- !!! This is the example given in TcDeriv
--
module ShouldSucceed where
diff --git a/ghc/tests/deriving/should_compile/drv004.hs b/ghc/tests/deriving/should_compile/drv004.hs
index 5c095ddeef75..324a7f81d449 100644
--- a/ghc/tests/deriving/should_compile/drv004.hs
+++ b/ghc/tests/deriving/should_compile/drv004.hs
@@ -1,4 +1,4 @@
---!!! simple example of deriving Ord and Eq simultaneously
+-- !!! simple example of deriving Ord and Eq simultaneously
--
module ShouldSucceed where
diff --git a/ghc/tests/deriving/should_compile/drv005.hs b/ghc/tests/deriving/should_compile/drv005.hs
index 93d8b45e0e00..527dde98b992 100644
--- a/ghc/tests/deriving/should_compile/drv005.hs
+++ b/ghc/tests/deriving/should_compile/drv005.hs
@@ -1,4 +1,4 @@
---!!! simple example of deriving Enum
+-- !!! simple example of deriving Enum
--
module ShouldSucceed where
diff --git a/ghc/tests/deriving/should_compile/drv006.hs b/ghc/tests/deriving/should_compile/drv006.hs
index b21d9f22fb6d..d2a88fd106ff 100644
--- a/ghc/tests/deriving/should_compile/drv006.hs
+++ b/ghc/tests/deriving/should_compile/drv006.hs
@@ -1,4 +1,4 @@
---!!! simple examples of deriving Ix
+-- !!! simple examples of deriving Ix
--
module ShouldSucceed where
import Ix
diff --git a/ghc/tests/deriving/should_compile/drv007.hs b/ghc/tests/deriving/should_compile/drv007.hs
index feb7297156f5..22da5b4aa349 100644
--- a/ghc/tests/deriving/should_compile/drv007.hs
+++ b/ghc/tests/deriving/should_compile/drv007.hs
@@ -1,4 +1,4 @@
---!!! deriving Ord on d. type with a single nullary constructor.
+-- !!! deriving Ord on d. type with a single nullary constructor.
-- (from ghc-2.10 panic - as reported by Sergey Mechveliani <mechvel@botik.ru>)
--
module ShouldSucceed where
diff --git a/ghc/tests/deriving/should_compile/drv008.hs b/ghc/tests/deriving/should_compile/drv008.hs
index c06332e26e3b..c374193777f0 100644
--- a/ghc/tests/deriving/should_compile/drv008.hs
+++ b/ghc/tests/deriving/should_compile/drv008.hs
@@ -1,4 +1,4 @@
---!!! deriving Ix on d. type with nullary constructors
+-- !!! deriving Ix on d. type with nullary constructors
module ShouldSucceed where
import Ix
diff --git a/ghc/tests/deriving/should_compile/drv009.hs b/ghc/tests/deriving/should_compile/drv009.hs
index 4d192788ba56..10e889e9292f 100644
--- a/ghc/tests/deriving/should_compile/drv009.hs
+++ b/ghc/tests/deriving/should_compile/drv009.hs
@@ -1,4 +1,4 @@
---!!! deriving Ix on d. type with one constructor
+-- !!! deriving Ix on d. type with one constructor
module ShouldSucceed where
import Ix
diff --git a/ghc/tests/deriving/should_compile/drv010.hs b/ghc/tests/deriving/should_compile/drv010.hs
index e6814507990f..1a3f9dc33aca 100644
--- a/ghc/tests/deriving/should_compile/drv010.hs
+++ b/ghc/tests/deriving/should_compile/drv010.hs
@@ -1,4 +1,4 @@
---!!! deriving Enum on d. type with nullary constructors
+-- !!! deriving Enum on d. type with nullary constructors
module ShouldSucceed where
data AD = A | B | C | D deriving (Enum)
diff --git a/ghc/tests/deriving/should_fail/drvfail004.hs b/ghc/tests/deriving/should_fail/drvfail004.hs
index cbdd96f29c46..6e090d8fe173 100644
--- a/ghc/tests/deriving/should_fail/drvfail004.hs
+++ b/ghc/tests/deriving/should_fail/drvfail004.hs
@@ -1,4 +1,4 @@
---!!! deriving Ord without deriving Eq
+-- !!! deriving Ord without deriving Eq
--
module ShouldFail where
diff --git a/ghc/tests/deriving/should_fail/drvfail007.hs b/ghc/tests/deriving/should_fail/drvfail007.hs
index 87efc246c9db..74f9f033d3c3 100644
--- a/ghc/tests/deriving/should_fail/drvfail007.hs
+++ b/ghc/tests/deriving/should_fail/drvfail007.hs
@@ -1,4 +1,4 @@
---!!! buggy deriving with function type, reported by Sigbjorn Finne
+-- !!! buggy deriving with function type, reported by Sigbjorn Finne
module ShouldFail where
data Foo = Foo (Int -> Int) deriving Eq
diff --git a/ghc/tests/typecheck/should_run/tcrun004.hs b/ghc/tests/typecheck/should_run/tcrun004.hs
new file mode 100644
index 000000000000..d20475886706
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun004.hs
@@ -0,0 +1,72 @@
+-- Originally from Kevin Glynn
+-- Tests existential data types
+
+module Main where
+
+data Coordinate3D = Coord3D {cx, cy, cz::Double}
+ deriving (Eq, Show)
+
+-- We Represent a line by two coordinates which it passes through.
+data Line = MkLine Coordinate3D Coordinate3D
+
+
+class PictureObject pot where
+
+ -- Returns ordered (rel to 0 0 0) of points where the object
+ -- intersects the given line.
+ intersectLineObject :: pot -> Line -> [Coordinate3D]
+
+ getPictureName :: pot -> String
+
+data Sphere =
+ Sphere Coordinate3D -- Centre
+ Double -- Radius
+ Double -- ambient coeff
+ Double -- diffuse coeff
+ Double -- specular coeff
+ Double -- phong specular exponent
+
+intersectLineSphere :: Sphere -> Line -> [Coordinate3D]
+intersectLineSphere sp line = []
+
+instance PictureObject Sphere where
+ intersectLineObject = intersectLineSphere
+ getPictureName _ = "Sphere"
+
+data Cube =
+ Cube Coordinate3D -- Origin corner
+ Coordinate3D -- Opposite corner
+ Double -- ambient coeff
+ Double -- diffuse coeff
+ Double -- specular coeff
+ Double -- phong specular exponent
+ deriving (Eq, Show)
+
+intersectLineCube :: Cube -> Line -> [Coordinate3D]
+intersectLineCube cube line = []
+
+instance PictureObject Cube where
+ intersectLineObject = intersectLineCube
+ getPictureName _ = "Cube"
+
+
+data GenPic = forall pot. (PictureObject pot) => MkGenPic pot
+
+sphere :: Sphere
+sphere = Sphere (Coord3D 1 1 1) 1 1 1 1 1
+
+cube :: Cube
+cube = Cube (Coord3D 1 1 1) (Coord3D 2 2 2) 1 1 1 1
+
+obj_list:: [GenPic]
+obj_list = [MkGenPic sphere, MkGenPic cube]
+
+putName :: PictureObject pot => pot -> IO ()
+putName x = putStr $ getPictureName x
+
+
+main :: IO ()
+main = do { sequence $ map put_it obj_list }
+ where
+ put_it (MkGenPic s) = putStr (getPictureName s)
+
--
GitLab