[Git][ghc/ghc][master] Add `__GLASGOW_HASKELL_ASSERTS_IGNORED__` as CPP macro name if `-fasserts-ignored is set.

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Jun 12 07:10:16 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
de4395cd by qqwy at 2024-06-12T03:09:12-04:00
Add `__GLASGOW_HASKELL_ASSERTS_IGNORED__` as CPP macro name if `-fasserts-ignored is set.

This allows users to create their own Control.Exception.assert-like functionality that
does something other than raising an `AssertFailed` exception.

Fixes #24967

- - - - -


8 changed files:

- compiler/GHC/SysTools/Cpp.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/assert.rst
- docs/users_guide/phases.rst
- + testsuite/tests/driver/cpp_assertions_ignored/Makefile
- + testsuite/tests/driver/cpp_assertions_ignored/all.T
- + testsuite/tests/driver/cpp_assertions_ignored/cpp_assertions_ignored.stdout
- + testsuite/tests/driver/cpp_assertions_ignored/main.hs


Changes:

=====================================
compiler/GHC/SysTools/Cpp.hs
=====================================
@@ -168,6 +168,9 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
     backend_defs <- applyCDefs (backendCDefs $ backend dflags) logger dflags
 
     let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
+
+    let asserts_def = [ "-D__GLASGOW_HASKELL_ASSERTS_IGNORED__" | gopt Opt_IgnoreAsserts dflags]
+
     -- Default CPP defines in Haskell source
     ghcVersionH <- getGhcVersionPathName dflags unit_env
     let hsSourceCppOpts = [ "-include", ghcVersionH ]
@@ -197,6 +200,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
                     ++ map GHC.SysTools.Option target_defs
                     ++ map GHC.SysTools.Option backend_defs
                     ++ map GHC.SysTools.Option th_defs
+                    ++ map GHC.SysTools.Option asserts_def
                     ++ map GHC.SysTools.Option hscpp_opts
                     ++ map GHC.SysTools.Option sse_defs
                     ++ map GHC.SysTools.Option fma_def


=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -75,6 +75,13 @@ Compiler
   <https://gitlab.haskell.org/ghc/ghc/-/issues/24921>`_). This does
   not affect existing support of apple systems on x86_64/aarch64.
 
+- The flag :ghc-flag:`-fignore-asserts` will now also enable the 
+  :extension:`CPP` macro ``__GLASGOW_HASKELL_ASSERTS_IGNORED__`` (`#24967
+  <https://gitlab.haskell.org/ghc/ghc/-/issues/24967>`_).
+  This enables people to write their own custom assertion functions.
+  See :ref:`assertions`.
+  
+
 GHCi
 ~~~~
 


=====================================
docs/users_guide/exts/assert.rst
=====================================
@@ -50,4 +50,20 @@ allows enabling assertions even when optimisation is turned on.
 Assertion failures can be caught, see the documentation for the
 :base-ref:`Control.Exception.` library for the details.
 
-
+The ``__GLASGOW_HASKELL_ASSERTS_IGNORED__`` CPP macro
+=====================================================
+
+When code is compiled with assertions ignored (using :ghc-flag:`-fignore-asserts` or :ghc-flag:`-O`),
+the :extension:`CPP` macro ``__GLASGOW_HASKELL_ASSERTS_IGNORED__`` will be defined.
+This can be used to conditionally compile your own custom assert-like functions.
+For example: ::
+
+    checkedAdd :: Word -> Word -> Word
+    #ifdef __GLASGOW_HASKELL_ASSERTS_IGNORED__
+      checkedAdd lhs rhs = lhs + rhs 
+    #else
+      checkedAdd lhs rhs
+        | res < lhs || res < rhs = raise OverflowException
+        | otherwise              = res
+        where res = lhs + rhs
+    #endif


=====================================
docs/users_guide/phases.rst
=====================================
@@ -508,6 +508,13 @@ defined by your local GHC installation, the following trick is useful:
     is added, so for example when using version 3.7 of LLVM,
     ``__GLASGOW_HASKELL_LLVM__==307``).
 
+``__GLASGOW_HASKELL_ASSERTS_IGNORED__``
+    .. index::
+       single: __GLASGOW_HASKELL_ASSERTS_IGNORED__
+
+    Only defined when :ghc-flag:`-fignore-asserts` is specified.
+    This can be used to create your own assertions, see :ref:`assertions`
+
 ``__PARALLEL_HASKELL__``
     .. index::
        single: __PARALLEL_HASKELL__


=====================================
testsuite/tests/driver/cpp_assertions_ignored/Makefile
=====================================
@@ -0,0 +1,11 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+cpp_assertions_ignored:
+	echo "Without -fignore-asserts"
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 main.hs
+	(./main 2>&1); true
+	echo "With -fignore-asserts"
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -fignore-asserts main.hs
+	./main 2>&1


=====================================
testsuite/tests/driver/cpp_assertions_ignored/all.T
=====================================
@@ -0,0 +1,4 @@
+test('cpp_assertions_ignored',
+     [ extra_files(['main.hs'])
+     ],
+     makefile_test, ['cpp_assertions_ignored'])


=====================================
testsuite/tests/driver/cpp_assertions_ignored/cpp_assertions_ignored.stdout
=====================================
@@ -0,0 +1,4 @@
+Without -fignore-asserts
+Assertions Enabled
+With -fignore-asserts
+Assertions Ignored


=====================================
testsuite/tests/driver/cpp_assertions_ignored/main.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+import Control.Exception (assert)
+
+main = 
+    if assertsEnabled 
+    then putStrLn "Assertions Enabled" 
+    else putStrLn "Assertions Ignored"
+
+assertsEnabled :: Bool
+#ifdef __GLASGOW_HASKELL_ASSERTS_IGNORED__
+assertsEnabled = False
+#else
+assertsEnabled = True
+#endif



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de4395cdf596f9e3d5e4ccd16e6c2eb94106f3ae
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/20240612/2dc34583/attachment-0001.html>


More information about the ghc-commits mailing list