From 445dc08293b6bcd4ced2a16855bc8906acb18105 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mois=C3=A9s=20Ackerman?= <m@akr.mn>
Date: Sat, 10 Jun 2023 17:11:55 +0200
Subject: [PATCH] Add failing test case for #23492
(cherry picked from commit 6074cc3cda9b9836c784942a1aa7f766fb142787)
---
testsuite/tests/hiefile/should_run/T23492.hs | 44 +++++++++++++++++++
.../tests/hiefile/should_run/T23492.stdout | 10 +++++
testsuite/tests/hiefile/should_run/all.T | 1 +
3 files changed, 55 insertions(+)
create mode 100644 testsuite/tests/hiefile/should_run/T23492.hs
create mode 100644 testsuite/tests/hiefile/should_run/T23492.stdout
diff --git a/testsuite/tests/hiefile/should_run/T23492.hs b/testsuite/tests/hiefile/should_run/T23492.hs
new file mode 100644
index 00000000000..d32644ce050
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/T23492.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Main where
+
+import TestUtils
+import qualified Data.Map as M
+import Data.Foldable
+
+-- regression test for https://gitlab.haskell.org/ghc/ghc/-/issues/23492
+data PartialFieldSelector
+ = NoFields
+ | PartialField { a :: Bool }
+-- ^
+-- 1
+
+f :: PartialFieldSelector -> Bool
+f x = a x
+-- ^
+-- 2
+
+g :: PartialFieldSelector -> Bool
+g x = x.a
+-- ^^^
+-- 345
+
+p1, p2, p3, p4, p5 :: (Int,Int)
+p1 = (13,20)
+p2 = (18,7)
+p3 = (23,7)
+p4 = (23,8)
+p5 = (23,9)
+
+selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
+selectPoint' hf loc =
+ maybe (error "point not found") id $ selectPoint hf loc
+
+main = do
+ (df, hf) <- readTestHie "T23492.hie"
+ forM_ [p1,p2,p3,p4,p5] $ \point -> do
+ putStr $ "At " ++ show point ++ ", got type: "
+ let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point
+ forM_ types $ \typ -> do
+ putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))
diff --git a/testsuite/tests/hiefile/should_run/T23492.stdout b/testsuite/tests/hiefile/should_run/T23492.stdout
new file mode 100644
index 00000000000..1c53e8ff657
--- /dev/null
+++ b/testsuite/tests/hiefile/should_run/T23492.stdout
@@ -0,0 +1,10 @@
+At (13,20), got type: PartialFieldSelector -> Bool
+Addr#
+Bool
+PartialFieldSelector
+Addr# -> Bool
+forall a. Addr# -> a
+At (18,7), got type: PartialFieldSelector -> Bool
+At (23,7), got type: PartialFieldSelector
+At (23,8), got type: PartialFieldSelector
+At (23,9), got type: Bool
diff --git a/testsuite/tests/hiefile/should_run/all.T b/testsuite/tests/hiefile/should_run/all.T
index 79d1858cfba..2fc72443cc6 100644
--- a/testsuite/tests/hiefile/should_run/all.T
+++ b/testsuite/tests/hiefile/should_run/all.T
@@ -1,5 +1,6 @@
test('PatTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('HieQueries', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('T20341', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('T23492', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('SpliceTypes', [req_th, extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
--
GitLab