[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: JS: implement getMonotonicTime (fix #23687)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Jul 31 13:20:48 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
df82be2f by Sylvain Henry at 2023-07-31T09:19:57-04:00
JS: implement getMonotonicTime (fix #23687)

- - - - -
bf1b74eb by Matthew Pickering at 2023-07-31T09:19:58-04:00
ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job

Warnings when building Hadrian can end up cluttering the output of HLS,
and we've had bug reports in the past about these warnings when building
Hadrian. It would be nice to turn on -Werror on at least one build of
Hadrian in CI to avoid a patch introducing warnings when building
Hadrian.

Fixes #23638

- - - - -
93256469 by Bartłomiej Cieślar at 2023-07-31T09:20:04-04:00
Add cases to T23279: HasField for deprecated record fields

This commit adds additional tests from ticket #23279 to ensure that we don't
regress on reporting deprecated record fields in conjunction with HasField,
either when using overloaded record dot syntax or directly through `getField`.

Fixes #23279

- - - - -
3a523556 by Andreas Klebinger at 2023-07-31T09:20:04-04:00
AArch NCG: Pure refactor

Combine some alternatives. Add some line breaks for overly long lines

- - - - -
db4314aa by Andreas Klebinger at 2023-07-31T09:20:05-04:00
Aarch ncg: Optimize immediate use for address calculations

When the offset doesn't fit into the immediate we now just reuse the
general getRegister' code path which is well optimized to compute the
offset into a register instead of a special case for CmmRegOff.

This means we generate a lot less code under certain conditions which is
why performance metrics for these improve.

-------------------------
Metric Decrease:
    T4801
    T5321FD
    T5321Fun
-------------------------

- - - - -


10 changed files:

- .gitlab-ci.yml
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- hadrian/ghci-cabal.in
- hadrian/src/Settings/Builders/Cabal.hs
- libraries/base/GHC/Clock.hsc
- libraries/base/GHC/Conc/POSIX.hs
- + libraries/base/tests/T23687.hs
- libraries/base/tests/all.T
- testsuite/tests/overloadedrecflds/should_compile/T23279.hs
- testsuite/tests/overloadedrecflds/should_compile/T23279.stderr


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -369,6 +369,9 @@ hadrian-ghc-in-ghci:
     - git clean -xdf && git submodule foreach git clean -xdf
     - .gitlab/ci.sh setup
     - .gitlab/ci.sh configure
+    # Enable -Werror when building hadrian
+    - "echo 'package hadrian'  > hadrian/cabal.project.local"
+    - "echo '  ghc-options: -Werror'  >> hadrian/cabal.project.local"
     # Load ghc-in-ghci then immediately exit and check the modules loaded
     - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok,"
   after_script:


=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -462,6 +462,23 @@ getBitmaskImm n w
   where
     truncated = narrowU w n
 
+-- | Load/store immediate.
+-- Depends on the width of the store to some extent.
+isOffsetImm :: Int -> Width -> Bool
+isOffsetImm off w
+  -- 8 bits + sign for unscaled offsets
+  | -256 <= off, off <= 255 = True
+  -- Offset using 12-bit positive immediate, scaled by width
+  -- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4
+  -- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8
+  -- 16-bit: 0 .. 8188, 8-bit: 0 -- 4095
+  | 0 <= off, off < 4096 * byte_width, off `mod` byte_width == 0 = True
+  | otherwise = False
+  where
+    byte_width = widthInBytes w
+
+
+
 
 -- TODO OPT: we might be able give getRegister
 --          a hint, what kind of register we want.
@@ -711,18 +728,11 @@ getRegister' config plat expr
       -> return (Fixed (cmmTypeFormat (cmmRegType reg))
                        (getRegisterReg plat reg)
                        nilOL)
-    CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do
-      getRegister' config plat $
-            CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
-          where width = typeWidth (cmmRegType reg)
-
-    CmmRegOff reg off -> do
-      (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width)
-      (reg, _format, code) <- getSomeReg $ CmmReg reg
-      return $ Any (intFormat width) (\dst -> off_code `appOL` code `snocOL` ADD (OpReg width dst) (OpReg width reg) (OpReg width off_r))
-          where width = typeWidth (cmmRegType reg)
-
-
+    CmmRegOff reg off ->
+      -- If we got here we will load the address into a register either way. So we might as well just expand
+      -- and re-use the existing code path to handle "reg + off".
+      let !width = cmmRegWidth reg
+      in getRegister' config plat (CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)])
 
     -- for MachOps, see GHC.Cmm.MachOp
     -- For CmmMachOp, see GHC.Cmm.Expr
@@ -794,33 +804,25 @@ getRegister' config plat expr
     -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg
     CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr'
     CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr'
-    -- 1. Compute Reg +/- n directly.
-    --    For Add/Sub we can directly encode 12bits, or 12bits lsl #12.
-    CmmMachOp (MO_Add w) [(CmmReg reg), CmmLit (CmmInt n _)]
-      | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ADD (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
-      -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
-      where w' = formatToWidth (cmmTypeFormat (cmmRegType reg))
-            r' = getRegisterReg plat reg
-    CmmMachOp (MO_Sub w) [(CmmReg reg), CmmLit (CmmInt n _)]
-      | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (SUB (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n))))
-      -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12.
-      where w' = formatToWidth (cmmTypeFormat (cmmRegType reg))
-            r' = getRegisterReg plat reg
+    -- Immediates are handled via `getArithImm` in the generic code path.
 
     CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+                                                                        (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL`
+                                                                        (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
     CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+                                                                        (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL`
+                                                                        (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
 
     -- 2. Shifts. x << n, x >> n.
-    CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
-      (reg_x, _format_x, code_x) <- getSomeReg x
-      return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
-    CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
+    CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))]
+      | w == W32 || w == W64
+      , 0 <= n, n < fromIntegral (widthInBits w) -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
 
@@ -830,7 +832,8 @@ getRegister' config plat expr
     CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+                                                                         (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
 
     CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
@@ -838,24 +841,23 @@ getRegister' config plat expr
     CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+                                                                         (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
 
-    CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
+    CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))]
+      | w == W32 || w == W64
+      , 0 <= n, n < fromIntegral (widthInBits w) -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
 
-    CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
-      (reg_x, _format_x, code_x) <- getSomeReg x
-      return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
-
-
     CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n)))))
     CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
+                                                                        (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
 
     CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
@@ -863,13 +865,12 @@ getRegister' config plat expr
     CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
-
-    CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
-      (reg_x, _format_x, code_x) <- getSomeReg x
-      return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x))
+                                                                `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
 
-    CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
+    CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))]
+      | w == W32 || w == W64
+      , 0 <= n, n < fromIntegral (widthInBits w) -> do
       (reg_x, _format_x, code_x) <- getSomeReg x
       return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
 
@@ -915,8 +916,8 @@ getRegister' config plat expr
           -- sign-extend both arguments to 32-bits.
           -- See Note [Signed arithmetic on AArch64].
           intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register)
-          intOpImm {- is signed -} True w op _encode_imm = intOp True w op
-          intOpImm False w op encode_imm = do
+          intOpImm {- is signed -} True  w op _encode_imm = intOp True w op
+          intOpImm                 False w op  encode_imm = do
               -- compute x<m> <- x
               -- compute x<o> <- y
               -- <OP> x<n>, x<m>, x<o>
@@ -1253,20 +1254,8 @@ getAmode :: Platform
 
 -- OPTIMIZATION WARNING: Addressing modes.
 -- Addressing options:
--- LDUR/STUR: imm9: -256 - 255
-getAmode platform _ (CmmRegOff reg off) | -256 <= off, off <= 255
-  = return $ Amode (AddrRegImm reg' off') nilOL
-    where reg' = getRegisterReg platform reg
-          off' = ImmInt off
--- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4
-getAmode platform W32 (CmmRegOff reg off)
-  | 0 <= off, off <= 16380, off `mod` 4 == 0
-  = return $ Amode (AddrRegImm reg' off') nilOL
-    where reg' = getRegisterReg platform reg
-          off' = ImmInt off
--- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8
-getAmode platform W64 (CmmRegOff reg off)
-  | 0 <= off, off <= 32760, off `mod` 8 == 0
+getAmode platform w (CmmRegOff reg off)
+  | isOffsetImm off w
   = return $ Amode (AddrRegImm reg' off') nilOL
     where reg' = getRegisterReg platform reg
           off' = ImmInt off
@@ -1275,15 +1264,15 @@ getAmode platform W64 (CmmRegOff reg off)
 -- CmmStore (CmmMachOp (MO_Add w) [CmmLoad expr, CmmLit (CmmInt n w')]) (expr2)
 -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ]
 -- for `n` in range.
-getAmode _platform _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')])
-  | -256 <= off, off <= 255
+getAmode _platform w (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')])
+  | isOffsetImm (fromIntegral off) w
   = do (reg, _format, code) <- getSomeReg expr
        return $ Amode (AddrRegImm reg (ImmInteger off)) code
 
-getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')])
-  | -256 <= -off, -off <= 255
+getAmode _platform w (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')])
+  | isOffsetImm (fromIntegral $ -off) w
   = do (reg, _format, code) <- getSomeReg expr
-       return $ Amode (AddrRegImm reg (ImmInteger (-off))) code
+       return $ Amode (AddrRegImm reg (ImmInteger $ -off)) code
 
 -- Generic case
 getAmode _platform _ expr


=====================================
hadrian/ghci-cabal.in
=====================================
@@ -5,6 +5,6 @@
 set -e
 export TOOL_OUTPUT=.hadrian_ghci/ghci_args
 # Replace newlines with spaces, as these otherwise break the ghci invocation on windows.
-CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS
+CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS
 GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')"
 @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m


=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -59,7 +59,6 @@ commonReinstallCabalArgs :: Args
 commonReinstallCabalArgs = do
     top       <- expr topDirectory
     root      <- getBuildRoot
-    threads   <- shakeThreads <$> expr getShakeOptions
     _pkg      <- getPackage
     compiler  <- expr $ programPath =<< programContext Stage1 ghc
     mconcat [ arg "--project-file"


=====================================
libraries/base/GHC/Clock.hsc
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -9,17 +10,36 @@ module GHC.Clock
 import GHC.Base
 import GHC.Real
 import Data.Word
+#if defined(javascript_HOST_ARCH)
+import GHC.Num
+#endif
 
 -- | Return monotonic time in seconds, since some unspecified starting point
 --
 -- @since 4.11.0.0
 getMonotonicTime :: IO Double
-getMonotonicTime = do w <- getMonotonicTimeNSec
-                      return (fromIntegral w / 1000000000)
+getMonotonicTime = do
+#if defined(javascript_HOST_ARCH)
+  w <- getMonotonicTimeMSec
+  return (w / 1000)
+#else
+  w <- getMonotonicTimeNSec
+  return (fromIntegral w / 1000000000)
+#endif
 
 -- | Return monotonic time in nanoseconds, since some unspecified starting point
 --
 -- @since 4.11.0.0
+#if defined(javascript_HOST_ARCH)
+getMonotonicTimeNSec :: IO Word64
+getMonotonicTimeNSec = do
+  w <- getMonotonicTimeMSec
+  return (floor w * 1000000)
+
+foreign import javascript unsafe "performance.now" getMonotonicTimeMSec:: IO Double
+
+
+#else
 foreign import ccall unsafe "getMonotonicNSec"
     getMonotonicTimeNSec :: IO Word64
-
+#endif


=====================================
libraries/base/GHC/Conc/POSIX.hs
=====================================
@@ -49,6 +49,7 @@ module GHC.Conc.POSIX
 
 import Data.Bits (shiftR)
 import GHC.Base
+import GHC.Clock
 import GHC.Conc.Sync
 import GHC.Conc.POSIX.Const
 import GHC.Event.Windows.ConsoleEvent
@@ -209,13 +210,9 @@ delayTime (Delay t _) = t
 delayTime (DelaySTM t _) = t
 
 type USecs = Word64
-type NSecs = Word64
-
-foreign import ccall unsafe "getMonotonicNSec"
-  getMonotonicNSec :: IO NSecs
 
 getMonotonicUSec :: IO USecs
-getMonotonicUSec = fmap (`div` 1000) getMonotonicNSec
+getMonotonicUSec = fmap (`div` 1000) getMonotonicTimeNSec
 
 {-# NOINLINE prodding #-}
 prodding :: IORef Bool


=====================================
libraries/base/tests/T23687.hs
=====================================
@@ -0,0 +1,14 @@
+module Main where
+
+import GHC.Clock
+import Control.Monad
+
+main :: IO ()
+main = do
+  a <- getMonotonicTimeNSec
+  b <- getMonotonicTimeNSec
+  when (a > b) $ putStrLn "Non-monotonic time"
+
+  c <- getMonotonicTime
+  d <- getMonotonicTime
+  when (c > d) $ putStrLn "Non-monotonic time"


=====================================
libraries/base/tests/all.T
=====================================
@@ -310,3 +310,4 @@ test('inits1tails1', normal, compile_and_run, [''])
 test('CLC149', normal, compile, [''])
 test('AtomicSwapIORef', normal, compile_and_run, [''])
 test('T23454', normal, compile_fail, [''])
+test('T23687', normal, compile_and_run, [''])


=====================================
testsuite/tests/overloadedrecflds/should_compile/T23279.hs
=====================================
@@ -1,10 +1,23 @@
-{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DuplicateRecordFields, DataKinds
+           , OverloadedLabels, OverloadedRecordDot #-}
 
 module T23279 where
 
 import T23279_aux
 
+import GHC.Records
+
+bar :: Bar
 bar = Bar { x = 3, y = 'x', z = False, w = 17.28 }
+
+baz :: Baz
 baz = Baz { z = 1.1 }
 
 v = w
+
+barDot :: Bar -> Int
+barDot b = b.x
+
+barGetField :: Bar -> Bool
+barGetField = getField @"z"
+


=====================================
testsuite/tests/overloadedrecflds/should_compile/T23279.stderr
=====================================
@@ -1,20 +1,28 @@
 
-T23279.hs:7:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+T23279.hs:11:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
     In the use of record field of Bar ‘x’ (imported from T23279_aux):
     Deprecated: "Don't use x"
 
-T23279.hs:7:29: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+T23279.hs:11:29: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
     In the use of record field of Bar ‘z’ (imported from T23279_aux):
     Deprecated: "Don't use z"
 
-T23279.hs:7:40: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+T23279.hs:11:40: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
     In the use of record field of Bar ‘w’ (imported from T23279_aux):
     Deprecated: "Don't use w"
 
-T23279.hs:8:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+T23279.hs:14:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
     In the use of record field of Baz ‘z’ (imported from T23279_aux):
     Deprecated: "Don't use z"
 
-T23279.hs:10:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+T23279.hs:16:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
     In the use of ‘w’ (imported from T23279_aux):
     Deprecated: "Don't use w"
+
+T23279.hs:19:12: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+    In the use of record field of Bar ‘x’ (imported from T23279_aux):
+    Deprecated: "Don't use x"
+
+T23279.hs:22:15: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+    In the use of record field of Bar ‘z’ (imported from T23279_aux):
+    Deprecated: "Don't use z"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2810170db7d66e385adb9199c85a306a8bf1cf56...db4314aa4917671c49c6602d4175256ec5c77e73

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2810170db7d66e385adb9199c85a306a8bf1cf56...db4314aa4917671c49c6602d4175256ec5c77e73
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230731/47b517da/attachment-0001.html>


More information about the ghc-commits mailing list