[Git][ghc/ghc][wip/24275] JS: Mark spurious CI failures js_fragile(24259)

Zubin (@wz1000) gitlab at gitlab.haskell.org
Tue Dec 19 15:51:31 UTC 2023



Zubin pushed to branch wip/24275 at Glasgow Haskell Compiler / GHC


Commits:
d9591bdf by Luite Stegeman at 2023-12-19T21:21:14+05:30
JS: Mark spurious CI failures js_fragile(24259)

This marks the spurious test failures on the JS platform as
js_fragile(24259), so we don't hold up merge requests while
fixing the underlying issues.

See #24259

- - - - -


17 changed files:

- compiler/GHC/Data/Graph/Directed.hs
- compiler/GHC/Driver/Make.hs
- libraries/base/tests/all.T
- testsuite/driver/testlib.py
- testsuite/tests/backpack/cabal/T20509/all.T
- testsuite/tests/backpack/cabal/bkpcabal02/all.T
- testsuite/tests/backpack/cabal/bkpcabal03/all.T
- testsuite/tests/concurrent/should_run/all.T
- + testsuite/tests/driver/T24275/T24275.stderr
- + testsuite/tests/driver/T24275/T24275A.hs
- + testsuite/tests/driver/T24275/T24275A.hs-boot
- + testsuite/tests/driver/T24275/T24275B.hs
- + testsuite/tests/driver/T24275/T24275B.hs-boot
- + testsuite/tests/driver/T24275/all.T
- testsuite/tests/ghc-api/downsweep/all.T
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/rts/all.T


Changes:

=====================================
compiler/GHC/Data/Graph/Directed.hs
=====================================
@@ -46,7 +46,7 @@ module GHC.Data.Graph.Directed (
 
 import GHC.Prelude
 
-import GHC.Utils.Misc ( minWith, count )
+import GHC.Utils.Misc ( sortWith, count )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Data.Maybe ( expectJust )
@@ -219,47 +219,52 @@ type WorkItem key payload
      [payload])         -- Rest of the path;
                         --  [a,b,c] means c depends on b, b depends on a
 
--- | Find a reasonably short cycle a->b->c->a, in a strongly
--- connected component.  The input nodes are presumed to be
--- a SCC, so you can start anywhere.
+-- | Find a reasonably short cycle a->b->c->a, in a graph
+-- The graph might not necessarily be strongly connected.
 findCycle :: forall payload key. Ord key
           => [Node key payload]     -- The nodes.  The dependencies can
                                     -- contain extra keys, which are ignored
           -> Maybe [payload]        -- A cycle, starting with node
                                     -- so each depends on the next
 findCycle graph
-  = go Set.empty (new_work root_deps []) []
+  = goRoots plausible_roots
   where
     env :: Map.Map key (Node key payload)
     env = Map.fromList [ (node_key node, node) | node <- graph ]
 
-    -- Find the node with fewest dependencies among the SCC modules
+    goRoots [] = Nothing
+    goRoots (root:xs) =
+        case go Set.empty (new_work root_deps []) [] of
+          Nothing -> goRoots xs
+          Just res -> Just res
+      where
+        DigraphNode root_payload root_key root_deps = root
+        -- 'go' implements Dijkstra's algorithm, more or less
+        go :: Set.Set key   -- Visited
+           -> [WorkItem key payload]        -- Work list, items length n
+           -> [WorkItem key payload]        -- Work list, items length n+1
+           -> Maybe [payload]               -- Returned cycle
+           -- Invariant: in a call (go visited ps qs),
+           --            visited = union (map tail (ps ++ qs))
+
+        go _       [] [] = Nothing  -- No cycles
+        go visited [] qs = go visited qs []
+        go visited (((DigraphNode payload key deps), path) : ps) qs
+           | key == root_key           = Just (root_payload : reverse path)
+           | key `Set.member` visited  = go visited ps qs
+           | key `Map.notMember` env   = go visited ps qs
+           | otherwise                 = go (Set.insert key visited)
+                                            ps (new_qs ++ qs)
+           where
+             new_qs = new_work deps (payload : path)
+
+
+    -- Find the nodes with fewest dependencies among the SCC modules
     -- This is just a heuristic to find some plausible root module
-    root :: Node key payload
-    root = fst (minWith snd [ (node, count (`Map.member` env)
-                                           (node_dependencies node))
-                            | node <- graph ])
-    DigraphNode root_payload root_key root_deps = root
-
-
-    -- 'go' implements Dijkstra's algorithm, more or less
-    go :: Set.Set key   -- Visited
-       -> [WorkItem key payload]        -- Work list, items length n
-       -> [WorkItem key payload]        -- Work list, items length n+1
-       -> Maybe [payload]               -- Returned cycle
-       -- Invariant: in a call (go visited ps qs),
-       --            visited = union (map tail (ps ++ qs))
-
-    go _       [] [] = Nothing  -- No cycles
-    go visited [] qs = go visited qs []
-    go visited (((DigraphNode payload key deps), path) : ps) qs
-       | key == root_key           = Just (root_payload : reverse path)
-       | key `Set.member` visited  = go visited ps qs
-       | key `Map.notMember` env   = go visited ps qs
-       | otherwise                 = go (Set.insert key visited)
-                                        ps (new_qs ++ qs)
-       where
-         new_qs = new_work deps (payload : path)
+    plausible_roots :: [Node key payload]
+    plausible_roots = map fst (sortWith snd [ (node, count (`Map.member` env) (node_dependencies node))
+                                            | node <- graph ])
+
 
     new_work :: [key] -> [payload] -> [WorkItem key payload]
     new_work deps path = [ (n, path) | Just n <- map (`Map.lookup` env) deps ]


=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -642,7 +642,7 @@ createBuildPlan mod_graph maybe_top_mod =
         collapseSCC :: [SCC ModuleGraphNode] -> Either [ModuleGraphNode] [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)]
         -- Must be at least two nodes, as we were in a cycle
         collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Right [toNodeWithBoot node1, toNodeWithBoot node2]
-        collapseSCC (AcyclicSCC node : nodes) = (toNodeWithBoot node :) <$> collapseSCC nodes
+        collapseSCC (AcyclicSCC node : nodes) = either (Left . (node :)) (Right . (toNodeWithBoot node :)) (collapseSCC nodes)
         -- Cyclic
         collapseSCC nodes = Left (flattenSCCs nodes)
 


=====================================
libraries/base/tests/all.T
=====================================
@@ -309,7 +309,7 @@ test('listThreads', normal, compile_and_run, [''])
 test('listThreads1', omit_ghci, compile_and_run, [''])
 test('inits1tails1', normal, compile_and_run, [''])
 test('CLC149', normal, compile, [''])
-test('AtomicModifyIORef', normal, compile_and_run, [''])
+test('AtomicModifyIORef', js_fragile(24259), compile_and_run, [''])
 test('AtomicSwapIORef', normal, compile_and_run, [''])
 test('T23454', normal, compile_fail, [''])
 test('T23687', normal, compile_and_run, [''])


=====================================
testsuite/driver/testlib.py
=====================================
@@ -153,6 +153,13 @@ def js_broken( bug: IssueNumber ):
     else:
         return normal;
 
+# expect occasional failures for the JS backend
+def js_fragile( bug: IssueNumber ):
+    if js_arch():
+        return fragile(bug);
+    else:
+        return normal;
+
 def expect_fail( name, opts ):
     # The compiler, testdriver, OS or platform is missing a certain
     # feature, and we don't plan to or can't fix it now or in the


=====================================
testsuite/tests/backpack/cabal/T20509/all.T
=====================================
@@ -1,6 +1,7 @@
 test('T20509',
      [extra_files(['p', 'q', 'T20509.cabal', 'Setup.hs'])
      , run_timeout_multiplier(2)
+     , js_fragile(24259)
      ],
      makefile_test,
      [])


=====================================
testsuite/tests/backpack/cabal/bkpcabal02/all.T
=====================================
@@ -1,5 +1,6 @@
 test('bkpcabal02',
      [extra_files(['p', 'q', 'bkpcabal02.cabal', 'Setup.hs']),
-      normalise_version('bkpcabal01')],
+      normalise_version('bkpcabal01'),
+      js_fragile(24259)],
      makefile_test,
      [])


=====================================
testsuite/tests/backpack/cabal/bkpcabal03/all.T
=====================================
@@ -1,4 +1,5 @@
 test('bkpcabal03',
-     [extra_files(['asig1', 'asig2', 'bkpcabal03.cabal.in1', 'bkpcabal03.cabal.in2', 'Setup.hs', 'Mod.hs'])],
+     [extra_files(['asig1', 'asig2', 'bkpcabal03.cabal.in1', 'bkpcabal03.cabal.in2', 'Setup.hs', 'Mod.hs']),
+      js_fragile(24259)],
      makefile_test,
      [])


=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -47,7 +47,7 @@ test('T3429', [ extra_run_opts('+RTS -C0.001 -RTS'),
 # times out with ghci
 test('T4030', omit_ghci, compile_and_run, ['-O'])
 
-test('throwto002', normal, compile_and_run, [''])
+test('throwto002', js_fragile(24259), compile_and_run, [''])
 test('throwto003', normal, compile_and_run, [''])
 
 test('mask001', normal, compile_and_run, [''])


=====================================
testsuite/tests/driver/T24275/T24275.stderr
=====================================
@@ -0,0 +1,4 @@
+Module graph contains a cycle:
+        module ‘T24275A’ (./T24275A.hs-boot)
+        imports module ‘T24275B’ (T24275B.hs)
+  which imports module ‘T24275A’ (./T24275A.hs-boot)


=====================================
testsuite/tests/driver/T24275/T24275A.hs
=====================================
@@ -0,0 +1 @@
+module T24275A where


=====================================
testsuite/tests/driver/T24275/T24275A.hs-boot
=====================================
@@ -0,0 +1,3 @@
+module T24275A where
+
+import T24275B


=====================================
testsuite/tests/driver/T24275/T24275B.hs
=====================================
@@ -0,0 +1,3 @@
+module T24275B where
+
+import {-# SOURCE #-} T24275A


=====================================
testsuite/tests/driver/T24275/T24275B.hs-boot
=====================================
@@ -0,0 +1 @@
+module T24275B where


=====================================
testsuite/tests/driver/T24275/all.T
=====================================
@@ -0,0 +1 @@
+test('T24275', extra_files(['T24275A.hs','T24275A.hs-boot','T24275B.hs-boot','T24275B.hs']), multimod_compile_fail, ['T24275B',''])


=====================================
testsuite/tests/ghc-api/downsweep/all.T
=====================================
@@ -3,6 +3,7 @@ setTestOpts(when(arch('wasm32'), run_timeout_multiplier(2)))
 test('PartialDownsweep',
      [ extra_run_opts('"' + config.libdir + '"')
      , ignore_stderr
+     , js_fragile(24259)
      ],
      compile_and_run,
      ['-package ghc -package exceptions'])


=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -79,6 +79,6 @@ test('IntegerToFloat', normal, compile_and_run, [''])
 
 test('T20291', normal, compile_and_run, [''])
 test('T22282', normal, compile_and_run, [''])
-test('T22671', normal, compile_and_run, [''])
-test('foundation', [when(js_arch(), run_timeout_multiplier(2))], compile_and_run, ['-O -package transformers'])
+test('T22671', js_fragile(24259), compile_and_run, [''])
+test('foundation', [when(js_arch(), run_timeout_multiplier(2)), js_fragile(24259)], compile_and_run, ['-O -package transformers'])
 test('T24066', normal, compile_and_run, [''])


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -302,6 +302,7 @@ test('T7919', [ when(fast(), skip)
               , omit_ghci
               , req_th
               , when(platform('x86_64-unknown-linux'), fragile(22283))
+              , js_fragile(24259)
               ]
               , compile_and_run, [config.ghc_th_way_flags])
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9591bdfed691c45895ab0329d02b3be97851f8a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9591bdfed691c45895ab0329d02b3be97851f8a
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/20231219/bd688f16/attachment-0001.html>


More information about the ghc-commits mailing list