Commit 225afc4a authored by Rik Steenkamp's avatar Rik Steenkamp Committed by thomie

Add test T9407 (Windows)

Add test for #9407. The test is only run on Windows 64bit, as this is
where the problem occurred.

Reviewed by: thomie

Differential Revision: https://phabricator.haskell.org/D1806
parent 84b0ebed
data Vec3 = Vec3 !Double !Double !Double
deriving (Show)
infixl 6 ^+^, ^-^
infixr 7 *^, <.>
negateV :: Vec3 -> Vec3
negateV (Vec3 x y z) = Vec3 (-x) (-y) (-z)
(^+^), (^-^) :: Vec3 -> Vec3 -> Vec3
Vec3 x1 y1 z1 ^+^ Vec3 x2 y2 z2 = Vec3 (x1 + x2) (y1 + y2) (z1 + z2)
v ^-^ v' = v ^+^ negateV v'
(*^) :: Double -> Vec3 -> Vec3
s *^ Vec3 x y z = Vec3 (s * x) (s * y) (s * z)
(<.>) :: Vec3 -> Vec3 -> Double
Vec3 x1 y1 z1 <.> Vec3 x2 y2 z2 = x1 * x2 + y1 * y2 + z1 * z2
magnitudeSq :: Vec3 -> Double
magnitudeSq v = v <.> v
normalized :: Vec3 -> Vec3
normalized v = (1 / sqrt (magnitudeSq v)) *^ v
class Surface s where
intersectSurfaceWithRay :: s -> Vec3 -> Vec3 -> Maybe Vec3
data Sphere = Sphere Vec3 Double
instance Surface Sphere where
intersectSurfaceWithRay (Sphere c r) o d =
let c' = c ^-^ o
b = c' <.> d
det = b^2 - magnitudeSq c' + r^2
det' = sqrt det
t1 = b - det'
t2 = b + det'
returnIntersection t =
let x = o ^+^ t *^ d
in Just (normalized (x ^-^ c))
in if det < 0 then Nothing
else if t1 > 1e-6 then returnIntersection t1
else if t2 > 1e-6 then returnIntersection t2
else Nothing
iappend :: Maybe Vec3 -> Maybe Vec3 -> Maybe Vec3
Nothing `iappend` i2 = i2
i1 `iappend` _ = i1
main :: IO ()
main = print $ foldl combine Nothing [Sphere (Vec3 0 0 0) 1]
where combine accum surf = accum `iappend`
intersectSurfaceWithRay surf (Vec3 0 0 5) (Vec3 0 0 (-1))
Just (Vec3 0.0 0.0 1.0)
\ No newline at end of file
......@@ -62,6 +62,11 @@ test('T7233', normal, compile_and_run, [''])
test('NumDecimals', normal, compile_and_run, [''])
test('T8726', normal, compile_and_run, [''])
test('CarryOverflow', omit_ways(['ghci']), compile_and_run, [''])
test('T9407', [
unless(opsys('mingw32') and wordsize(64), skip),
only_ways(['optasm'])
],
compile_and_run, [''])
test('T9810', normal, compile_and_run, [''])
test('T10011', normal, compile_and_run, [''])
test('T10962', omit_ways(['ghci']), compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment