[Git][ghc/ghc][wip/T23479] test

Serge S. Gulin (@gulin.serge) gitlab at gitlab.haskell.org
Mon Oct 14 20:53:27 UTC 2024



Serge S. Gulin pushed to branch wip/T23479 at Glasgow Haskell Compiler / GHC


Commits:
c2e27327 by Serge S. Gulin at 2024-10-14T23:53:16+03:00
test

- - - - -


3 changed files:

- compiler/GHC/StgToJS/Apply.hs
- testsuite/tests/javascript/Makefile
- testsuite/tests/javascript/T24495.stdout


Changes:

=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -126,6 +126,26 @@ genApp ctx i args
     , [top] <- concatMap typex_expr (ctxTarget ctx)
     = return . (,ExprInline) $ top |= toJExpr d
 
+    -- Test case T24495 with single occurrence at -02 and third occurrence at -01
+    -- Moved back from removal at https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12308
+    -- See commit hash b36ee57bfbecc628b7f0919e1e59b7066495034f
+    --
+    -- Case: unpackCStringAppend# "some string"# str
+    --
+    -- Generates h$appendToHsStringA(str, "some string"), which has a faster
+    -- decoding loop.
+    | [StgLitArg (LitString bs), x] <- args
+    , Just d <- decodeModifiedUTF8 bs
+    , getUnique i == unpackCStringAppendIdKey
+    , [top] <- concatMap typex_expr (ctxTarget ctx)
+    = do
+        prof <- csProf <$> getSettings
+        let profArg = if prof then [jCafCCS] else []
+        a <- genArg x
+        return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg)
+               , ExprInline
+               )
+
     -- let-no-escape
     | Just n <- ctxLneBindingStackSize ctx i
     = do


=====================================
testsuite/tests/javascript/Makefile
=====================================
@@ -5,7 +5,12 @@ include $(TOP)/mk/test.mk
 T24495:
 	'$(TEST_HC)' $(TEST_HC_OPTS) T24495.hs -v0 -O1 -dsuppress-uniques -ddump-js -ddump-to-file
 	./T24495
-	# check that the optimization occurred
+	# check that the optimization occurred for -01 3 times (2 for cases + 1 for unfloated lits)
+	grep -c appendToHsStringA T24495.dump-js
+
+	'$(TEST_HC)' $(TEST_HC_OPTS) T24495.hs -v0 -O2 -dsuppress-uniques -ddump-js -ddump-to-file
+	./T24495
+	# check that the optimization occurred for -02 1 time (1 for unfloated lits)
 	grep -c appendToHsStringA T24495.dump-js
 
 T23479_1:


=====================================
testsuite/tests/javascript/T24495.stdout
=====================================
@@ -1,2 +1,4 @@
 2 ab bd
-2
+3
+2 ab bd
+1



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

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


More information about the ghc-commits mailing list