Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
08bbc028
by Rodrigo Mesquita at 2025-11-20T17:33:54-05:00
7 changed files:
- + testsuite/tests/bytecode/T23973.hs
- + testsuite/tests/bytecode/T23973.script
- + testsuite/tests/bytecode/T23973.stdout
- + testsuite/tests/bytecode/T26565.hs
- + testsuite/tests/bytecode/T26565.script
- + testsuite/tests/bytecode/T26565.stdout
- testsuite/tests/bytecode/all.T
Changes:
| 1 | +{-# LANGUAGE GADTs #-}
|
|
| 2 | +{-# LANGUAGE LinearTypes #-}
|
|
| 3 | + |
|
| 4 | +module Main (main) where
|
|
| 5 | + |
|
| 6 | +data Ur a where
|
|
| 7 | + Ur :: a -> Ur a
|
|
| 8 | + |
|
| 9 | +unur :: Ur a -> a
|
|
| 10 | +unur (Ur a) = a
|
|
| 11 | + |
|
| 12 | +segvGHCi :: Ur ()
|
|
| 13 | +segvGHCi = Ur $ ()
|
|
| 14 | + |
|
| 15 | +main :: IO ()
|
|
| 16 | +main = print (unur segvGHCi)
|
|
| 17 | + |
| 1 | +:l T23973.hs
|
|
| 2 | +main |
| 1 | +() |
| 1 | +{-# LANGUAGE LinearTypes #-}
|
|
| 2 | +module Test where
|
|
| 3 | + |
|
| 4 | +data Ur a where
|
|
| 5 | + Ur :: a -> Ur a
|
|
| 6 | + |
| 1 | +:l T26565
|
|
| 2 | +Ur y = (\x -> Ur $ replicate 5 'a') 3
|
|
| 3 | +y |
| 1 | +"aaaaa" |
| ... | ... | @@ -6,6 +6,8 @@ test('T25975', extra_ways(ghci_ways), compile_and_run, |
| 6 | 6 | # Some of the examples work more robustly with these flags
|
| 7 | 7 | ['-fno-break-points -fno-full-laziness'])
|
| 8 | 8 | |
| 9 | +test('T26565', extra_files(["T26565.hs"]), ghci_script, ['T26565.script'])
|
|
| 10 | +test('T23973', extra_files(["T23973.hs"]), ghci_script, ['T23973.script'])
|
|
| 11 | + |
|
| 9 | 12 | # Nullary data constructors
|
| 10 | 13 | test('T26216', extra_files(["T26216_aux.hs"]), ghci_script, ['T26216.script']) |
| 11 | - |