[Git][ghc/ghc][wip/expand-mdo] 5 commits: ts: add compile_artifact, ignore_extension flag

Apoorv Ingle (@ani) gitlab at gitlab.haskell.org
Thu Feb 8 01:42:45 UTC 2024



Apoorv Ingle pushed to branch wip/expand-mdo at Glasgow Haskell Compiler / GHC


Commits:
569b4c10 by doyougnu at 2024-02-07T03:06:26-05:00
ts: add compile_artifact, ignore_extension flag

In b521354216f2821e00d75f088d74081d8b236810 the testsuite gained the
capability to collect generic metrics. But this assumed that the test
was not linking and producing artifacts and we only wanted to track
object files, interface files, or build artifacts from the compiler
build. However, some backends, such as the JS backend, produce artifacts when
compiling, such as the jsexe directory which we want to track.

This patch:

- tweaks the testsuite to collect generic metrics on any build artifact
in the test directory.

- expands the exe_extension function to consider windows and adds the
ignore_extension flag.

- Modifies certain tests to add the ignore_extension flag. Tests such as
heaprof002 expect a .ps file, but on windows without ignore_extensions
the testsuite will look for foo.exe.ps. Hence the flag.

- adds the size_hello_artifact test

- - - - -
75a31379 by doyougnu at 2024-02-07T03:06:26-05:00
ts: add wasm_arch, heapprof002 wasm extension

- - - - -
c9731d6d by Rodrigo Mesquita at 2024-02-07T03:07:03-05:00
Synchronize bindist configure for #24324

In cdddeb0f1280b40cc194028bbaef36e127175c4c, we set up a
workaround for #24324 in the in-tree configure script, but forgot to
update the bindist configure script accordingly. This updates it.

- - - - -
d309f4e7 by Matthew Pickering at 2024-02-07T03:07:38-05:00
distrib/configure: Fix typo in CONF_GCC_LINKER_OPTS_STAGE2 variable

Instead we were setting CONF_GCC_LINK_OPTS_STAGE2 which meant that we
were missing passing `--target` when invoking the linker.

Fixes #24414

- - - - -
26ede40e by Apoorv Ingle at 2024-02-07T19:41:25-06:00
Enable mdo statements to use HsExpansions
Fixes: #24411
Added test T24411 for regression

- - - - -


15 changed files:

- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Match.hs
- distrib/configure.ac.in
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/hpc/function/test.T
- testsuite/tests/hpc/function2/test.T
- testsuite/tests/hpc/simple/test.T
- testsuite/tests/perf/size/all.T
- + testsuite/tests/perf/size/size_hello_artifact.hs
- testsuite/tests/profiling/should_run/all.T
- + testsuite/tests/typecheck/should_run/T24411.hs
- + testsuite/tests/typecheck/should_run/T24411.stdout
- testsuite/tests/typecheck/should_run/all.T
- testsuite/tests/typecheck/testeq1/test.T


Changes:

=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -791,6 +791,9 @@ addArgCtxt :: AppCtxt -> LHsExpr GhcRn
 --    b. Or, we are typechecking the second argument which would be a generated lambda
 --       so we set the location to be whatever the location in the context is
 --  See Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do
+-- For future: we need a cleaner way of doing this bit of adding the right error context.
+-- There is a delicate dance of looking at source locations and reconstructing
+-- whether the piece of code is a `do`-expanded code or some other expanded code.
 addArgCtxt ctxt (L arg_loc arg) thing_inside
   = do { in_generated_code <- inGeneratedCode
        ; case ctxt of


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -364,10 +364,9 @@ tcDoStmts doExpr@(DoExpr _) ss@(L l stmts) res_ty
                   ; mkExpandedExprTc (HsDo noExtField doExpr ss) <$> tcExpr (unLoc expanded_expr) res_ty }
         }
 
-tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty
-  = do  { stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty
-        ; res_ty <- readExpType res_ty
-        ; return (HsDo res_ty mDoExpr (L l stmts')) }
+tcDoStmts mDoExpr@(MDoExpr _) ss@(L _ stmts) res_ty
+  = do  { expanded_expr <- expandDoStmts mDoExpr stmts -- Do expansion on the fly
+        ; mkExpandedExprTc (HsDo noExtField mDoExpr ss) <$> tcExpr (unLoc expanded_expr) res_ty  }
 
 tcDoStmts MonadComp (L l stmts) res_ty
   = do  { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty


=====================================
distrib/configure.ac.in
=====================================
@@ -109,6 +109,9 @@ dnl ** Which gcc to use?
 dnl --------------------------------------------------------------
 AC_PROG_CC([gcc clang])
 AC_PROG_CXX([g++ clang++ c++])
+# Work around #24324
+MOVE_TO_FLAGS([CC],[CFLAGS])
+MOVE_TO_FLAGS([CXX],[CXXFLAGS])
 
 dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`)
 AC_PROG_CPP
@@ -244,8 +247,8 @@ AC_SUBST(TargetHasGnuNonexecStack)
 
 dnl ** See whether cc supports --target=<triple> and set
 dnl CONF_CC_OPTS_STAGE[12] accordingly.
-FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1])
-FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2])
+FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1])
+FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2])
 
 dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang
 FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1])


=====================================
testsuite/driver/testglobals.py
=====================================
@@ -352,6 +352,9 @@ class TestOptions:
        self.ignore_stdout = False
        self.ignore_stderr = False
 
+       # don't use the executable extension
+       self.ignore_extension = False
+
        # Backpack test
        self.compile_backpack = False
 


=====================================
testsuite/driver/testlib.py
=====================================
@@ -138,9 +138,6 @@ def no_deps( name, opts):
 def skip( name, opts ):
     opts.skip = True
 
-def js_arch() -> bool:
-    return arch("javascript");
-
 # disable test on JS arch
 def js_skip( name, opts ):
     if js_arch():
@@ -379,6 +376,18 @@ def ignore_stdout(name, opts):
 def ignore_stderr(name, opts):
     opts.ignore_stderr = True
 
+def ignore_extension(name, opts):
+    """
+    Some tests generate files that are not expected to be suffixed with an
+    extension type, such as .exe on windows. This option allows these tests to
+    have finer-grained control over the filename that the testsuite will look
+    for. Examples of such tests are hpc tests which expect a .tix extension and
+    hp2ps tests which expect .hp. For these tests, on windows and without
+    ignoring the extension, the testsuite will look for, e.g., 'foo.exe.tix'
+    instead of 'foo.tix'.
+    """
+    opts.ignore_extension = True
+
 def combined_output( name, opts ):
     opts.combined_output = True
 
@@ -792,6 +801,8 @@ KNOWN_OPERATING_SYSTEMS = set([
 def exe_extension() -> str:
     if config.arch == 'wasm32':
         return '.wasm'
+    elif config.os == "mingw32":
+        return '.exe'
     return ''
 
 def opsys( os: str ) -> bool:
@@ -810,6 +821,12 @@ def msys( ) -> bool:
 def cygwin( ) -> bool:
     return config.cygwin
 
+def js_arch() -> bool:
+    return arch("javascript");
+
+def wasm_arch() -> bool:
+    return arch("wasm32")
+
 def have_vanilla( ) -> bool:
     return config.have_vanilla
 
@@ -1577,6 +1594,10 @@ async def ghci_script( name, way, script):
 async def compile( name, way, extra_hc_opts ):
     return await do_compile( name, way, False, None, [],  [], extra_hc_opts )
 
+async def compile_artifact( name, way, extra_hc_opts ):
+    # We suppress stderr so that the link output isn't compared
+    return await do_compile( name, way, False, None, [], [], extra_hc_opts, should_link=True, compare_stderr=False )
+
 async def compile_fail( name, way, extra_hc_opts ):
     return await do_compile( name, way, True, None, [], [], extra_hc_opts )
 
@@ -1592,9 +1613,6 @@ async def backpack_compile( name, way, extra_hc_opts ):
 async def backpack_compile_fail( name, way, extra_hc_opts ):
     return await do_compile( name, way, True, None, [], [], extra_hc_opts, backpack=True )
 
-async def backpack_run( name, way, extra_hc_opts ):
-    return await compile_and_run__( name, way, None, [], extra_hc_opts, backpack=True )
-
 async def multimod_compile( name, way, top_mod, extra_hc_opts ):
     return await do_compile( name, way, False, top_mod, [], [], extra_hc_opts )
 
@@ -1623,6 +1641,8 @@ async def do_compile(name: TestName,
                extra_mods: List[str],
                units: List[str],
                extra_hc_opts: str,
+               should_link=False,
+               compare_stderr=True,
                **kwargs
                ) -> PassFail:
     # print 'Compile only, extra args = ', extra_hc_opts
@@ -1632,7 +1652,7 @@ async def do_compile(name: TestName,
        return result
     extra_hc_opts = result.hc_opts
 
-    result = await simple_build(name, way, extra_hc_opts, should_fail, top_mod, units, False, True, **kwargs)
+    result = await simple_build(name, way, extra_hc_opts, should_fail, top_mod, units, should_link, True, **kwargs)
 
     if badResult(result):
         return result
@@ -1645,7 +1665,7 @@ async def do_compile(name: TestName,
     actual_stderr_file = add_suffix(name, 'comp.stderr')
     diff_file_name = in_testdir(add_suffix(name, 'comp.diff'))
 
-    if not await compare_outputs(way, 'stderr',
+    if compare_stderr and not await compare_outputs(way, 'stderr',
                            join_normalisers(getTestOpts().extra_errmsg_normaliser,
                                             normalise_errmsg),
                            expected_stderr_file, actual_stderr_file,
@@ -1747,7 +1767,8 @@ async def compile_and_run__(name: TestName,
                       extra_mods: List[str],
                       extra_hc_opts: str,
                       backpack: bool=False,
-                      compile_stderr: bool=False
+                      compile_stderr: bool=False,
+                      use_extension: bool=True
                       ) -> PassFail:
     # print 'Compile and run, extra args = ', extra_hc_opts
 
@@ -1780,8 +1801,11 @@ async def compile_and_run__(name: TestName,
              stderr = diff_file_name.read_text()
              diff_file_name.unlink()
              return failBecause('ghc.stderr mismatch', stderr=stderr)
-#
-        cmd = './' + name + exe_extension()
+
+        opts = getTestOpts()
+        extension = exe_extension() if not opts.ignore_extension else ""
+
+        cmd = './' + name + extension
 
         # we don't check the compiler's stderr for a compile-and-run test
         return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
@@ -1789,6 +1813,9 @@ async def compile_and_run__(name: TestName,
 async def compile_and_run( name, way, extra_hc_opts ):
     return await compile_and_run__( name, way, None, [], extra_hc_opts)
 
+async def backpack_run( name, way, extra_hc_opts ):
+    return await compile_and_run__( name, way, None, [], extra_hc_opts, backpack=True )
+
 async def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ):
     return await compile_and_run__( name, way, top_mod, [], extra_hc_opts)
 
@@ -2296,8 +2323,8 @@ def write_file(f: Path, s: str) -> None:
 # operate on bytes.
 
 async def check_hp_ok(name: TestName) -> bool:
-    actual_name = name + exe_extension()
     opts = getTestOpts()
+    actual_name = name + exe_extension() if not opts.ignore_extension else name
 
     # do not qualify for hp2ps because we should be in the right directory
     hp2psCmd = 'cd "{opts.testdir}" && {{hp2ps}} {actual_name}'.format(**locals())


=====================================
testsuite/tests/hpc/function/test.T
=====================================
@@ -5,5 +5,6 @@ hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}"
 test('tough',
      [extra_files(['../hpcrun.pl']),
       cmd_prefix(hpc_prefix),
+      ignore_extension,
       when(arch('wasm32'), fragile(23243))],
      compile_and_run, ['-fhpc'])


=====================================
testsuite/tests/hpc/function2/test.T
=====================================
@@ -10,6 +10,7 @@ test('tough2',
      [extra_files(['../hpcrun.pl', 'subdir/']),
        literate,
        cmd_prefix(hpc_prefix),
+       ignore_extension,
        omit_ways(ghci_ways + prof_ways), # profile goes in the wrong place
        when(arch('wasm32'), fragile(23243)) ],
      multimod_compile_and_run, ['subdir/tough2.lhs', '-fhpc'])


=====================================
testsuite/tests/hpc/simple/test.T
=====================================
@@ -3,6 +3,7 @@ setTestOpts([omit_ghci, when(fast(), skip), js_skip])
 hpc_prefix = "perl hpcrun.pl --clear --exeext={exeext} --hpc={hpc}"
 
 test('hpc001', [extra_files(['../hpcrun.pl']), cmd_prefix(hpc_prefix),
-     when(arch('wasm32'), fragile(23243))
+     when(arch('wasm32'), fragile(23243)),
+     ignore_extension
      ],
      compile_and_run, ['-fhpc'])


=====================================
testsuite/tests/perf/size/all.T
=====================================
@@ -1,3 +1,6 @@
 test('size_hello_obj', [collect_size(5, 'size_hello_obj.o')], compile, [''])
 
+test('size_hello_artifact', [collect_size(5, 'size_hello_artifact' + exe_extension())],
+                             compile_artifact, [''])
+
 test('libdir',[collect_size_dir(10, config.libdir)], static_stats, [] )


=====================================
testsuite/tests/perf/size/size_hello_artifact.hs
=====================================
@@ -0,0 +1,4 @@
+-- same as size_hello_obj but we test the size of the resulting executable.
+module Main where
+
+main = print "Hello World!"


=====================================
testsuite/tests/profiling/should_run/all.T
=====================================
@@ -4,6 +4,7 @@ setTestOpts(js_skip) # JS backend doesn't support profiling yet
 
 test('heapprof002',
      [extra_files(['heapprof001.hs']),
+      when(not(wasm_arch()),ignore_extension),
       pre_cmd('cp heapprof001.hs heapprof002.hs'), extra_ways(['normal_h']),
       extra_run_opts('7')],
      compile_and_run, [''])


=====================================
testsuite/tests/typecheck/should_run/T24411.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE ImpredicativeTypes, RecursiveDo #-}
+
+type Id = forall a. a -> a
+
+t :: IO Id
+t = return id
+
+p :: Id -> (Bool, Int)
+p f = (f True, f 3)
+
+foo1 = t >>= \x -> return (p x)
+
+foo2 = mdo { x <- t ; return (p x) }
+
+main = do x <- foo2
+          y <- foo1
+          putStrLn $ show x
+          putStrLn $ show y


=====================================
testsuite/tests/typecheck/should_run/T24411.stdout
=====================================
@@ -0,0 +1,2 @@
+(True,3)
+(True,3)


=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -176,3 +176,4 @@ test('T23761b', normal, compile_and_run, [''])
 test('T18324', normal, compile_and_run, [''])
 test('T15598', normal, compile_and_run, [''])
 test('T22086', normal, compile_and_run, [''])
+test('T24411', normal, compile_and_run, [''])


=====================================
testsuite/tests/typecheck/testeq1/test.T
=====================================
@@ -1,6 +1,7 @@
 
 test('typecheck.testeq1', [ extra_files(['FakePrelude.hs', 'Main.hs', 'TypeCast.hs', 'TypeEq.hs'])
                           , when(fast(), skip)
+                          , ignore_extension
                           , js_broken(22355)
                           # https://gitlab.haskell.org/ghc/ghc/-/issues/23238
                           , when(arch('wasm32'), skip)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6de45f438c67a126982fc60292c7abf692e363c8...26ede40e440425a6d9f0d895a40e9c667652b642

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6de45f438c67a126982fc60292c7abf692e363c8...26ede40e440425a6d9f0d895a40e9c667652b642
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/20240207/4523ea41/attachment-0001.html>


More information about the ghc-commits mailing list