[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: testsuite: fix InternalCounters test with +debug_ghc

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Feb 21 13:46:24 UTC 2025



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
59b9307b by Cheng Shao at 2025-02-19T20:24:40-05:00
testsuite: fix InternalCounters test with +debug_ghc

The `InternalCounters` test case fails when ghc is built with
`+debug_ghc`. This patch skips it in that case and allows the
testsuite to pass for the `+debug_ghc` flavour transformer.

- - - - -
aa69187d by M Farkas-Dyck at 2025-02-19T20:25:31-05:00
Scrub a use of `head` in `GHC.Driver.Make.downsweep_imports.checkDuplicates`.

- - - - -
899f01a7 by Cheng Shao at 2025-02-21T08:46:04-05:00
compiler: use fromAscList when applicable

This patch uses fromAscList (with O(n) complexity) instead of fromList
(with O(nlogn) complexity) in certain Binary instances. It's safe to
do so since the corresponding serialization logic is based on toList
(same as toAscList).

- - - - -
6a202096 by Ben Gamari at 2025-02-21T08:46:05-05:00
rts/linker/MachO: Mark internal symbols as static

There is no reason why these should have external linkage.

- - - - -


4 changed files:

- compiler/GHC/Driver/Make.hs
- compiler/GHC/Utils/Binary.hs
- rts/linker/MachO.c
- testsuite/tests/rts/all.T


Changes:

=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1682,9 +1682,9 @@ downsweep_imports hsc_env old_summaries excl_mods allow_dup_roots (root_errs, ro
           :: DownsweepCache
           -> IO ()
         checkDuplicates root_map
-           | allow_dup_roots = return ()
-           | null dup_roots  = return ()
-           | otherwise       = liftIO $ multiRootsErr (head dup_roots)
+           | not allow_dup_roots
+           , dup_root:_ <- dup_roots = liftIO $ multiRootsErr dup_root
+           | otherwise = pure ()
            where
              dup_roots :: [[ModSummary]]        -- Each at least of length 2
              dup_roots = filterOut isSingleton $ map rights (M.elems root_map)


=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -940,8 +940,8 @@ instance Binary a => Binary [a] where
 -- | This instance doesn't rely on the determinism of the keys' 'Ord' instance,
 -- so it works e.g. for 'Name's too.
 instance (Binary a, Ord a) => Binary (Set a) where
-  put_ bh s = put_ bh (Set.toList s)
-  get bh = Set.fromList <$> get bh
+  put_ bh s = put_ bh (Set.toAscList s)
+  get bh = Set.fromAscList <$> get bh
 
 instance Binary a => Binary (NonEmpty a) where
     put_ bh = put_ bh . NonEmpty.toList
@@ -2086,5 +2086,5 @@ source location as part of a larger structure.
 --------------------------------------------------------------------------------
 
 instance (Binary v) => Binary (IntMap v) where
-  put_ bh m = put_ bh (IntMap.toList m)
-  get bh = IntMap.fromList <$> get bh
+  put_ bh m = put_ bh (IntMap.toAscList m)
+  get bh = IntMap.fromAscList <$> get bh


=====================================
rts/linker/MachO.c
=====================================
@@ -51,7 +51,7 @@
 /* often times we need to extend some value of certain number of bits
  * int an int64_t for e.g. relative offsets.
  */
-int64_t signExtend(uint64_t val, uint8_t bits);
+static int64_t signExtend(uint64_t val, uint8_t bits);
 /* Helper functions to check some instruction properties */
 static bool isVectorOp(uint32_t *p);
 static bool isLoadStore(uint32_t *p);
@@ -60,17 +60,17 @@ static bool isLoadStore(uint32_t *p);
  * where we want to write the address offset to. Thus decoding as well
  * as encoding is needed.
  */
-bool fitsBits(size_t bits, int64_t value);
-int64_t decodeAddend(ObjectCode * oc, Section * section,
+static bool fitsBits(size_t bits, int64_t value);
+static int64_t decodeAddend(ObjectCode * oc, Section * section,
                      MachORelocationInfo * ri);
-void encodeAddend(ObjectCode * oc, Section * section,
+static void encodeAddend(ObjectCode * oc, Section * section,
                   MachORelocationInfo * ri, int64_t addend);
 
 /* Global Offset Table logic */
-bool isGotLoad(MachORelocationInfo * ri);
-bool needGotSlot(MachONList * symbol);
-bool makeGot(ObjectCode * oc);
-void freeGot(ObjectCode * oc);
+static bool isGotLoad(MachORelocationInfo * ri);
+static bool needGotSlot(MachONList * symbol);
+static bool makeGot(ObjectCode * oc);
+static void freeGot(ObjectCode * oc);
 #endif /* aarch64_HOST_ARCH */
 
 /*
@@ -265,7 +265,7 @@ resolveImports(
 #if defined(aarch64_HOST_ARCH)
 /* aarch64 linker by moritz angermann <moritz at lichtzwerge.de> */
 
-int64_t
+static int64_t
 signExtend(uint64_t val, uint8_t bits) {
     return (int64_t)(val << (64-bits)) >> (64-bits);
 }
@@ -280,7 +280,7 @@ isLoadStore(uint32_t *p) {
     return (*p & 0x3B000000) == 0x39000000;
 }
 
-int64_t
+static int64_t
 decodeAddend(ObjectCode * oc, Section * section, MachORelocationInfo * ri) {
 
     /* the instruction. It is 32bit wide */
@@ -350,7 +350,7 @@ decodeAddend(ObjectCode * oc, Section * section, MachORelocationInfo * ri) {
     barf("unsupported relocation type: %d\n", ri->r_type);
 }
 
-inline bool
+inline static bool
 fitsBits(size_t bits, int64_t value) {
     if(bits == 64) return true;
     if(bits > 64) barf("fits_bits with %zu bits and an 64bit integer!", bits);
@@ -358,7 +358,7 @@ fitsBits(size_t bits, int64_t value) {
         || -1 == (value >> bits);  // All bits on: -1
 }
 
-void
+static void
 encodeAddend(ObjectCode * oc, Section * section,
              MachORelocationInfo * ri, int64_t addend) {
     uint32_t * p = (uint32_t*)((uint8_t*)section->start + ri->r_address);
@@ -440,7 +440,7 @@ encodeAddend(ObjectCode * oc, Section * section,
     barf("unsupported relocation type: %d\n", ri->r_type);
 }
 
-bool
+static bool
 isGotLoad(struct relocation_info * ri) {
     return ri->r_type == ARM64_RELOC_GOT_LOAD_PAGE21
     ||  ri->r_type == ARM64_RELOC_GOT_LOAD_PAGEOFF12;
@@ -450,7 +450,7 @@ isGotLoad(struct relocation_info * ri) {
  * Check if we need a global offset table slot for a
  * given symbol
  */
-bool
+static bool
 needGotSlot(MachONList * symbol) {
     return (symbol->n_type & N_EXT)             /* is an external symbol      */
         && (N_UNDF == (symbol->n_type & N_TYPE) /* and is undefined           */
@@ -458,7 +458,7 @@ needGotSlot(MachONList * symbol) {
                                                  *        different section   */
 }
 
-bool
+static bool
 makeGot(ObjectCode * oc) {
     size_t got_slots = 0;
 
@@ -484,7 +484,7 @@ makeGot(ObjectCode * oc) {
     return EXIT_SUCCESS;
 }
 
-void
+static void
 freeGot(ObjectCode * oc) {
     /* sanity check */
     if(NULL != oc->info->got_start && oc->info->got_size > 0) {


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -470,6 +470,8 @@ test('InternalCounters',
     # The ways which build against the debug RTS are built with PROF_SPIN and
     # therefore differ in output
   , omit_ways(['nonmoving_thr_sanity', 'threaded2_sanity', 'sanity'])
+    # Likewise when ghc is linked with debug RTS using +debug_ghc
+  , when(debug_rts(), skip)
   ], makefile_test, ['InternalCounters'])
 test('alloccounter1', js_broken(22261), compile_and_run,
   [



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa21815ce7ef5192a3e158435cf1226a4aee0231...6a2020960567de879f96642f0e5842ed884fcaa0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa21815ce7ef5192a3e158435cf1226a4aee0231...6a2020960567de879f96642f0e5842ed884fcaa0
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/20250221/1b3b1922/attachment-0001.html>


More information about the ghc-commits mailing list