From 8324f0b7357c428f505dccbc84bb7dde897b509c Mon Sep 17 00:00:00 2001 From: Bodigrim <andrew.lelechenko@gmail.com> Date: Thu, 21 Nov 2019 20:04:33 +0000 Subject: [PATCH] Test proxy-polymorphic sameNat and sameSymbol --- testsuite/tests/lib/base/T17310.hs | 24 ++++++++++++++++++++++++ testsuite/tests/lib/base/all.T | 1 + 2 files changed, 25 insertions(+) create mode 100644 testsuite/tests/lib/base/T17310.hs diff --git a/testsuite/tests/lib/base/T17310.hs b/testsuite/tests/lib/base/T17310.hs new file mode 100644 index 000000000000..97e9961f04be --- /dev/null +++ b/testsuite/tests/lib/base/T17310.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} + +module Lib where + +import Data.Type.Equality +import GHC.TypeLits +import GHC.TypeNats + +data A (t :: Nat) = A +data B (t :: Nat) = B +data C (t :: Symbol) = C +data D (t :: Symbol) = D + +cmpNats :: (KnownNat n, KnownNat m) => A n -> B m -> Bool +cmpNats a b = case a `sameNat` b of + Nothing -> False + Just Refl -> True + +cmpSymbols :: (KnownSymbol n, KnownSymbol m) => C n -> D m -> Bool +cmpSymbols c d = case c `sameSymbol` d of + Nothing -> False + Just Refl -> True diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T index e368dcad604a..f6770cf91a6b 100644 --- a/testsuite/tests/lib/base/all.T +++ b/testsuite/tests/lib/base/all.T @@ -1,3 +1,4 @@ test('T16586', normal, compile_and_run, ['-O2']) # Event-manager not supported on Windows test('T16916', when(opsys('mingw32'), skip), compile_and_run, ['-O2 -threaded']) +test('T17310', normal, compile, ['']) -- GitLab