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 1e42f19..d45d7b8 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 67c5d82..56505d6 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 06faa31..14a9921 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 f7537d6..cc54395 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 84e4a76..62ed12c 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 ff2c561..8aa1ddd 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 2a4d9ae..ec0c983 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 6b07292..30d79a6 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 ad9f0a6..b45e9e3 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 ead7d65..94bf8f3 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 fca26f9..f4a95d1 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 98da45e..e0ed3a9 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 86996a1..7efb1b5 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 465a433..2c93e8a 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 d3ed1f1..48880c6 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 a3dbf78..4ac4c82 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 488491f..3740107 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 f0dd58c..4019f61 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 7dbbf72..36d6a77 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 eded2ff..6f7207f 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 ffe8196..694af6a 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 f6d6780..0b8149c 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 5c095dd..324a7f8 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 93d8b45..527dde9 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 b21d9f2..d2a88fd 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 feb7297..22da5b4 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 c06332e..c374193 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 4d19278..10e889e 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 e681450..1a3f9dc 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 cbdd96f..6e090d8 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 87efc24..74f9f03 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 0000000..d204758
--- /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)
+
-- 
1.7.10.4