[Git][ghc/ghc][wip/testsuite-generic-stats] 4 commits: JS: clean up some foreign imports
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Sun Nov 19 14:14:59 UTC 2023
Matthew Pickering pushed to branch wip/testsuite-generic-stats at Glasgow Haskell Compiler / GHC
Commits:
faff671a by Luite Stegeman at 2023-11-17T14:12:51+01:00
JS: clean up some foreign imports
- - - - -
856e0a4e by Sven Tennie at 2023-11-18T06:54:11-05:00
AArch64: Remove unused instructions
As these aren't ever emitted, we don't even know if they work or will
ever be used. If one of them is needed in future, we may easily re-add
it.
Deleted instructions are:
- CMN
- ANDS
- BIC
- BICS
- EON
- ORN
- ROR
- TST
- STP
- LDP
- DMBSY
- - - - -
615441ef by Alan Zimmerman at 2023-11-18T06:54:46-05:00
EPA: Replace Monoid with NoAnn
Remove the final Monoid instances in the exact print infrastructure.
For Windows CI
Metric Decrease:
T5205
- - - - -
294f189f by Matthew Pickering at 2023-11-19T14:14:40+00:00
testsuite: Add mechanism to collect generic metrics
* Generalise the metric logic by adding an additional field which
allows you to specify how to query for the actual value. Previously
the method of querying the baseline value was abstracted (but always
set to the same thing).
* This requires rejigging how the stat collection works slightly but now
it's more uniform and hopefully simpler.
* Introduce some new "generic" helper functions for writing generic
stats tests.
- collect_size ( deviation, path )
Record the size of the file as a metric
- stat_from_file ( metric, deviation, path )
Read a value from the given path, and store that as a metric
- collect_generic_stat ( metric, deviation, get_stat )
Provide your own `get_stat` function, `lambda way: <Int>`, which
can be used to establish the value of the metric.
- collect_generic_stats ( get_stats ):
Like collect_generic_stat but provide the whole dictionary of metric
definitions.
{ metric: {
deviation: <Int>
action: lambda way: <Int>
} }
* Introduce two new "size" metrics for keeping track of build products.
- `size_hello` - The size of `hello.o` from compiling hello.hs
- `libdir` - The total size of the `libdir` folder.
* Track the number of modules in the AST tests
- CountDepsAst
- CountDepsParser
This lays the infrastructure for #24191 #22256 #17129
- - - - -
21 changed files:
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/Parser/Annotation.hs
- libraries/base/src/GHC/JS/Foreign/Callback.hs
- libraries/base/src/GHC/JS/Prim.hs
- libraries/base/src/GHC/JS/Prim/Internal.hs
- libraries/base/src/System/Posix/Internals.hs
- + rts/js/config.js
- rts/js/thread.js
- rts/rts.cabal
- testsuite/driver/perf_notes.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/count-deps/Makefile
- testsuite/tests/count-deps/all.T
- testsuite/tests/perf/haddock/all.T
- + testsuite/tests/perf/size/Makefile
- + testsuite/tests/perf/size/all.T
- + testsuite/tests/perf/size/size_hello.hs
- utils/check-exact/Orphans.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -434,7 +434,7 @@ getMovWideImm n w
-- | Arithmetic(immediate)
-- Allows for 12bit immediates which can be shifted by 0 or 12 bits.
--- Used with ADD, ADDS, SUB, SUBS, CMP, CMN
+-- Used with ADD, ADDS, SUB, SUBS, CMP
-- See Note [Aarch64 immediates]
getArithImm :: Integer -> Width -> Maybe Operand
getArithImm n w
@@ -459,7 +459,7 @@ getArithImm n w
-- | Logical (immediate)
-- Allows encoding of some repeated bitpatterns
--- Used with AND, ANDS, EOR, ORR, TST
+-- Used with AND, EOR, ORR
-- and their aliases which includes at least MOV (bitmask immediate)
-- See Note [Aarch64 immediates]
getBitmaskImm :: Integer -> Width -> Maybe Operand
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -79,7 +79,6 @@ regUsageOfInstr platform instr = case instr of
-- 1. Arithmetic Instructions ------------------------------------------------
ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- CMN l r -> usage (regOp l ++ regOp r, [])
CMP l r -> usage (regOp l ++ regOp r, [])
MSUB dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -102,9 +101,6 @@ regUsageOfInstr platform instr = case instr of
-- 3. Logical and Move Instructions ------------------------------------------
AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- EON dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
EOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -113,8 +109,6 @@ regUsageOfInstr platform instr = case instr of
MOVZ dst src -> usage (regOp src, regOp dst)
MVN dst src -> usage (regOp src, regOp dst)
ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- TST src1 src2 -> usage (regOp src1 ++ regOp src2, [])
-- 4. Branch Instructions ----------------------------------------------------
J t -> usage (regTarget t, [])
B t -> usage (regTarget t, [])
@@ -131,12 +125,8 @@ regUsageOfInstr platform instr = case instr of
STLR _ src dst -> usage (regOp src ++ regOp dst, [])
LDR _ dst src -> usage (regOp src, regOp dst)
LDAR _ dst src -> usage (regOp src, regOp dst)
- -- TODO is this right? see STR, which I'm only partial about being right?
- STP _ src1 src2 dst -> usage (regOp src1 ++ regOp src2 ++ regOp dst, [])
- LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2)
-- 8. Synchronization Instructions -------------------------------------------
- DMBSY -> usage ([], [])
DMBISH -> usage ([], [])
-- 9. Floating Point Instructions --------------------------------------------
@@ -219,7 +209,6 @@ patchRegsOfInstr instr env = case instr of
DELTA{} -> instr
-- 1. Arithmetic Instructions ----------------------------------------------
ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
- CMN o1 o2 -> CMN (patchOp o1) (patchOp o2)
CMP o1 o2 -> CMP (patchOp o1) (patchOp o2)
MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3)
@@ -242,11 +231,7 @@ patchRegsOfInstr instr env = case instr of
-- 3. Logical and Move Instructions ----------------------------------------
AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3)
- ANDS o1 o2 o3 -> ANDS (patchOp o1) (patchOp o2) (patchOp o3)
ASR o1 o2 o3 -> ASR (patchOp o1) (patchOp o2) (patchOp o3)
- BIC o1 o2 o3 -> BIC (patchOp o1) (patchOp o2) (patchOp o3)
- BICS o1 o2 o3 -> BICS (patchOp o1) (patchOp o2) (patchOp o3)
- EON o1 o2 o3 -> EON (patchOp o1) (patchOp o2) (patchOp o3)
EOR o1 o2 o3 -> EOR (patchOp o1) (patchOp o2) (patchOp o3)
LSL o1 o2 o3 -> LSL (patchOp o1) (patchOp o2) (patchOp o3)
LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3)
@@ -255,8 +240,6 @@ patchRegsOfInstr instr env = case instr of
MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2)
MVN o1 o2 -> MVN (patchOp o1) (patchOp o2)
ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3)
- ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3)
- TST o1 o2 -> TST (patchOp o1) (patchOp o2)
-- 4. Branch Instructions --------------------------------------------------
J t -> J (patchTarget t)
@@ -274,11 +257,8 @@ patchRegsOfInstr instr env = case instr of
STLR f o1 o2 -> STLR f (patchOp o1) (patchOp o2)
LDR f o1 o2 -> LDR f (patchOp o1) (patchOp o2)
LDAR f o1 o2 -> LDAR f (patchOp o1) (patchOp o2)
- STP f o1 o2 o3 -> STP f (patchOp o1) (patchOp o2) (patchOp o3)
- LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3)
-- 8. Synchronization Instructions -----------------------------------------
- DMBSY -> DMBSY
DMBISH -> DMBISH
-- 9. Floating Point Instructions ------------------------------------------
@@ -560,7 +540,6 @@ data Instr
-- | ADDS Operand Operand Operand -- rd = rn + rm
-- | ADR ...
-- | ADRP ...
- | CMN Operand Operand -- rd + op2
| CMP Operand Operand -- rd - op2
-- | MADD ...
-- | MNEG ...
@@ -601,11 +580,7 @@ data Instr
-- 3. Logical and Move Instructions ----------------------------------------
| AND Operand Operand Operand -- rd = rn & op2
- | ANDS Operand Operand Operand -- rd = rn & op2
| ASR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits
- | BIC Operand Operand Operand -- rd = rn & ~op2
- | BICS Operand Operand Operand -- rd = rn & ~op2
- | EON Operand Operand Operand -- rd = rn ⊕ ~op2
| EOR Operand Operand Operand -- rd = rn ⊕ op2
| LSL Operand Operand Operand -- rd = rn ≪ rm or rd = rn ≪ #i, i is 6 bits
| LSR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits
@@ -614,18 +589,13 @@ data Instr
-- | MOVN Operand Operand
| MOVZ Operand Operand
| MVN Operand Operand -- rd = ~rn
- | ORN Operand Operand Operand -- rd = rn | ~op2
| ORR Operand Operand Operand -- rd = rn | op2
- | ROR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits
- | TST Operand Operand -- rn & op2
-- Load and stores.
-- TODO STR/LDR might want to change to STP/LDP with XZR for the second register.
| STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr
| STLR Format Operand Operand -- stlr Xn, address-mode // Xn -> *addr
| LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr
| LDAR Format Operand Operand -- ldar Xn, address-mode // Xn <- *addr
- | STP Format Operand Operand Operand -- stp Xn, Xm, address-mode // Xn -> *addr, Xm -> *(addr + 8)
- | LDP Format Operand Operand Operand -- stp Xn, Xm, address-mode // Xn <- *addr, Xm <- *(addr + 8)
-- Conditional instructions
| CSET Operand Cond -- if(cond) op <- 1 else op <- 0
@@ -639,7 +609,6 @@ data Instr
| BCOND Cond Target -- branch with condition. b.<cond>
-- 8. Synchronization Instructions -----------------------------------------
- | DMBSY
| DMBISH
-- 9. Floating Point Instructions
-- Float ConVerT
@@ -675,7 +644,6 @@ instrCon i =
PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME"
POP_STACK_FRAME{} -> "POP_STACK_FRAME"
ADD{} -> "ADD"
- CMN{} -> "CMN"
CMP{} -> "CMP"
MSUB{} -> "MSUB"
MUL{} -> "MUL"
@@ -690,11 +658,7 @@ instrCon i =
SBFX{} -> "SBFX"
UBFX{} -> "UBFX"
AND{} -> "AND"
- ANDS{} -> "ANDS"
ASR{} -> "ASR"
- BIC{} -> "BIC"
- BICS{} -> "BICS"
- EON{} -> "EON"
EOR{} -> "EOR"
LSL{} -> "LSL"
LSR{} -> "LSR"
@@ -702,16 +666,11 @@ instrCon i =
MOVK{} -> "MOVK"
MOVZ{} -> "MOVZ"
MVN{} -> "MVN"
- ORN{} -> "ORN"
ORR{} -> "ORR"
- ROR{} -> "ROR"
- TST{} -> "TST"
STR{} -> "STR"
STLR{} -> "STLR"
LDR{} -> "LDR"
LDAR{} -> "LDAR"
- STP{} -> "STP"
- LDP{} -> "LDP"
CSET{} -> "CSET"
CBZ{} -> "CBZ"
CBNZ{} -> "CBNZ"
@@ -719,7 +678,6 @@ instrCon i =
B{} -> "B"
BL{} -> "BL"
BCOND{} -> "BCOND"
- DMBSY{} -> "DMBSY"
DMBISH{} -> "DMBISH"
FCVT{} -> "FCVT"
SCVTF{} -> "SCVTF"
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -370,7 +370,6 @@ pprInstr platform instr = case instr of
ADD o1 o2 o3
| isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3
| otherwise -> op3 (text "\tadd") o1 o2 o3
- CMN o1 o2 -> op2 (text "\tcmn") o1 o2
CMP o1 o2
| isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2
| otherwise -> op2 (text "\tcmp") o1 o2
@@ -405,11 +404,7 @@ pprInstr platform instr = case instr of
-- 3. Logical and Move Instructions ------------------------------------------
AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3
- ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3
ASR o1 o2 o3 -> op3 (text "\tasr") o1 o2 o3
- BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3
- BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3
- EON o1 o2 o3 -> op3 (text "\teon") o1 o2 o3
EOR o1 o2 o3 -> op3 (text "\teor") o1 o2 o3
LSL o1 o2 o3 -> op3 (text "\tlsl") o1 o2 o3
LSR o1 o2 o3 -> op3 (text "\tlsr") o1 o2 o3
@@ -419,10 +414,7 @@ pprInstr platform instr = case instr of
MOVK o1 o2 -> op2 (text "\tmovk") o1 o2
MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2
MVN o1 o2 -> op2 (text "\tmvn") o1 o2
- ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3
ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3
- ROR o1 o2 o3 -> op3 (text "\tror") o1 o2 o3
- TST o1 o2 -> op2 (text "\ttst") o1 o2
-- 4. Branch Instructions ----------------------------------------------------
J t -> pprInstr platform (B t)
@@ -526,12 +518,9 @@ pprInstr platform instr = case instr of
LDR _f o1 o2 -> op2 (text "\tldr") o1 o2
LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2
- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3
- LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3
-
-- 8. Synchronization Instructions -------------------------------------------
- DMBSY -> line $ text "\tdmb sy"
DMBISH -> line $ text "\tdmb ish"
+
-- 9. Floating Point Instructions --------------------------------------------
FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2
SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -1393,7 +1393,7 @@ instance (Semigroup a) => Semigroup (EpAnn a) where
-- annotations must follow it. So we combine them which yields the
-- largest span
-instance Semigroup Anchor where
+instance Semigroup EpaLocation where
EpaSpan s1 m1 <> EpaSpan s2 m2 = EpaSpan (combineRealSrcSpans s1 s2) (liftA2 combineBufSpans m1 m2)
EpaSpan s1 m1 <> _ = EpaSpan s1 m1
_ <> EpaSpan s2 m2 = EpaSpan s2 m2
=====================================
libraries/base/src/GHC/JS/Foreign/Callback.hs
=====================================
@@ -145,5 +145,5 @@ foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1,
foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1, h$runSyncReturn, [false], $2); })"
js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b)
-foreign import javascript unsafe "(($1) => { return h$release($1); })"
+foreign import javascript unsafe "h$release"
js_release :: Callback a -> IO ()
=====================================
libraries/base/src/GHC/JS/Prim.hs
=====================================
@@ -259,16 +259,16 @@ seqList xs = go xs `seq` xs
where go (y:ys) = y `seq` go ys
go [] = ()
-foreign import javascript unsafe "(($1) => { return h$toHsString($1); })"
+foreign import javascript unsafe "h$toHsString"
js_fromJSString :: JSVal -> Exts.Any
-foreign import javascript unsafe "(($1) => { return h$fromHsString($1); })"
+foreign import javascript unsafe "h$fromHsString"
js_toJSString :: Exts.Any -> JSVal
-foreign import javascript unsafe "(($1) => { return h$toHsListJSVal($1); })"
+foreign import javascript unsafe "h$toHsListJSVal"
js_fromJSArray :: JSVal -> IO Exts.Any
-foreign import javascript unsafe "(($1) => { return h$fromHsListJSVal($1); })"
+foreign import javascript unsafe "h$fromHsListJSVal"
js_toJSArray :: Exts.Any -> IO JSVal
foreign import javascript unsafe "(($1) => { return ($1 === null); })"
=====================================
libraries/base/src/GHC/JS/Prim/Internal.hs
=====================================
@@ -43,14 +43,14 @@ foreign import javascript unsafe
js_setCurrentThreadResultWouldBlock :: IO ()
foreign import javascript unsafe
- "(($1) => { return h$setCurrentThreadResultJSException($1); })"
+ "h$setCurrentThreadResultJSException"
js_setCurrentThreadResultJSException :: JSVal -> IO ()
foreign import javascript unsafe
- "(($1) => { return h$setCurrentThreadResultHaskellException($1); })"
+ "h$setCurrentThreadResultHaskellException"
js_setCurrentThreadResultHaskellException :: JSVal -> IO ()
foreign import javascript unsafe
- "(($1) => { return h$setCurrentThreadResultValue($1); })"
+ "h$setCurrentThreadResultValue"
js_setCurrentThreadResultValue :: JSVal -> IO ()
=====================================
libraries/base/src/System/Posix/Internals.hs
=====================================
@@ -504,7 +504,7 @@ foreign import ccall unsafe "HsBase.h __hscore_lstat"
#if defined(javascript_HOST_ARCH)
-foreign import javascript unsafe "(() => { return rts_isThreaded; })" rtsIsThreaded_ :: Int
+foreign import javascript unsafe "h$rts_isThreaded" rtsIsThreaded_ :: Int
foreign import javascript interruptible "h$base_access"
c_access :: CString -> CInt -> IO CInt
foreign import javascript interruptible "h$base_chmod"
=====================================
rts/js/config.js
=====================================
@@ -0,0 +1,21 @@
+function h$rts_isThreaded() {
+ return 0;
+}
+
+function h$rts_isTracing() {
+ return 0;
+}
+
+function h$rts_isDynamic() {
+ return 0;
+}
+
+function h$rts_isDebugged() {
+ return 0;
+}
+
+function h$rts_isProfiled() {
+ return 0;
+}
+
+
\ No newline at end of file
=====================================
rts/js/thread.js
=====================================
@@ -1460,5 +1460,3 @@ function h$makeMVarListener(mv, stopProp, stopImmProp, preventDefault) {
function h$rs() {
return h$stack[h$sp];
}
-
-const rts_isThreaded = 0;
=====================================
rts/rts.cabal
=====================================
@@ -99,6 +99,7 @@ library
c-sources: version.c
js-sources:
+ js/config.js
js/structs.js
js/arith.js
js/compact.js
=====================================
testsuite/driver/perf_notes.py
=====================================
@@ -123,11 +123,6 @@ AllowedPerfChange = NamedTuple('AllowedPerfChange',
('opts', Dict[str, str])
])
-MetricBaselineOracle = Callable[[WayName, GitHash], Baseline]
-MetricDeviationOracle = Callable[[WayName, GitHash], Optional[float]]
-MetricOracles = NamedTuple("MetricOracles", [("baseline", MetricBaselineOracle),
- ("deviation", MetricDeviationOracle)])
-
def parse_perf_stat(stat_str: str) -> PerfStat:
field_vals = stat_str.strip('\t').split('\t')
stat = PerfStat(*field_vals) # type: ignore
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -4,7 +4,7 @@
from my_typing import *
from pathlib import Path
-from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles, GitRef
+from perf_notes import MetricChange, PerfStat, Baseline, GitRef
from datetime import datetime
# -----------------------------------------------------------------------------
@@ -378,24 +378,20 @@ class TestOptions:
# extra files to copy to the testdir
self.extra_files = [] # type: List[str]
- # Map from metric to (function from way and commit to baseline value, allowed percentage deviation) e.g.
- # { 'bytes allocated': (
- # lambda way commit:
- # ...
- # if way1: return None ...
- # elif way2:return 9300000000 ...
- # ...
- # , 10) }
- # This means no baseline is available for way1. For way 2, allow a 10%
- # deviation from 9300000000.
- self.stats_range_fields = {} # type: Dict[MetricName, MetricOracles]
-
# Is the test testing performance?
self.is_stats_test = False
# Does this test the compiler's performance as opposed to the generated code.
self.is_compiler_stats_test = False
+ # Map from metric to information about that metric
+ # { metric: { "deviation": <int>
+ # The action to run to get the current value of the test
+ # , "action": lambda way: <Int>
+ # The action to run to get the baseline value of the test
+ # , "oracle": lambda way commit: baseline value } }
+ self.generic_stats_test: Dict = {} # Dict
+
# should we run this test alone, i.e. not run it in parallel with
# any other threads
self.alone = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -28,7 +28,7 @@ from term_color import Color, colored
import testutil
from cpu_features import have_cpu_feature
import perf_notes as Perf
-from perf_notes import MetricChange, PerfStat, MetricOracles
+from perf_notes import MetricChange, PerfStat
extra_src_files = {'T4198': ['exitminus1.c']} # TODO: See #12223
from my_typing import *
@@ -99,6 +99,10 @@ def isCompilerStatsTest() -> bool:
opts = getTestOpts()
return bool(opts.is_compiler_stats_test)
+def isGenericStatsTest() -> bool:
+ opts = getTestOpts()
+ return bool(opts.generic_stats_test)
+
def isStatsTest() -> bool:
opts = getTestOpts()
return opts.is_stats_test
@@ -599,6 +603,44 @@ def extra_files(files):
def _extra_files(name, opts, files):
opts.extra_files.extend(files)
+# Record the size of a specific file
+def collect_size ( deviation, path ):
+ return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path)) )
+
+# Read a number from a specific file
+def stat_from_file ( metric, deviation, path ):
+ def read_file (way):
+ with open(in_testdir(path)) as f:
+ return int(f.read())
+ return collect_generic_stat ( metric, deviation, read_file )
+
+
+# Define a set of generic stat tests
+def collect_generic_stats ( get_stats ):
+ def f(name, opts, f=get_stats):
+ return _collect_generic_stat(name, opts, get_stats)
+ return f
+
+# Define the a generic stat test, which computes the statistic by calling the function
+# given as the third argument.
+def collect_generic_stat ( metric, deviation, get_stat ):
+ return collect_generic_stats ( { metric: { 'deviation': deviation, 'action': get_stat } } )
+
+def _collect_generic_stat(name : TestName, opts, get_stat):
+
+
+ # Add new stats to the stat list
+ opts.generic_stats_test.update(get_stat)
+
+ # Add the "oracle" which determines the stat baseline
+ for (metric, info) in get_stat.items():
+ def baselineByWay(way, target_commit, metric=metric):
+ return Perf.baseline_metric( \
+ target_commit, name, config.test_env, metric, way, \
+ config.baseline_commit )
+ opts.generic_stats_test[metric]["oracle"] = baselineByWay
+
+
# -----
# Defaults to "test everything, and only break on extreme cases"
@@ -619,11 +661,14 @@ def _extra_files(name, opts, files):
def collect_compiler_stats(metric='all',deviation=20):
def f(name, opts, m=metric, d=deviation):
no_lint(name, opts)
- return _collect_stats(name, opts, m, d, True)
+ return _collect_stats(name, opts, m, d, None, True)
return f
-def collect_stats(metric='all', deviation=20):
- return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m, d)
+def collect_stats(metric='all', deviation=20, static_stats_file=None):
+ return lambda name, opts, m=metric, d=deviation, s=static_stats_file: _collect_stats(name, opts, m, d, s)
+
+def statsFile(comp_test: bool, name: str) -> str:
+ return name + ('.comp' if comp_test else '') + '.stats'
# This is an internal function that is used only in the implementation.
# 'is_compiler_stats_test' is somewhat of an unfortunate name.
@@ -631,7 +676,7 @@ def collect_stats(metric='all', deviation=20):
# measures the performance numbers of the compiler.
# As this is a fairly rare case in the testsuite, it defaults to false to
# indicate that it is a 'normal' performance test.
-def _collect_stats(name: TestName, opts, metrics, deviation, is_compiler_stats_test=False):
+def _collect_stats(name: TestName, opts, metrics, deviation, static_stats_file, is_compiler_stats_test=False):
if not re.match('^[0-9]*[a-zA-Z][a-zA-Z0-9._-]*$', name):
failBecause('This test has an invalid name.')
@@ -664,15 +709,41 @@ def _collect_stats(name: TestName, opts, metrics, deviation, is_compiler_stats_t
# The nonmoving collector does not support -G1
_omit_ways(name, opts, [WayName(name) for name in ['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']])
+ # How to read the result of the performance test
+ def read_stats_file(way, metric_name):
+ # Confusingly compile time ghci tests are actually runtime tests, so we have
+ # to go and look for the name.stats file rather than name.comp.stats file.
+ compiler_stats_test = is_compiler_stats_test and not (way == "ghci" or way == "ghci-opt")
+
+ if static_stats_file:
+ stats_file = in_statsdir(static_stats_file)
+ else:
+ stats_file = Path(in_testdir(statsFile(compiler_stats_test, name)))
+
+
+ try:
+ stats_file_contents = stats_file.read_text()
+ except IOError as e:
+ raise Exception(failBecause(str(e)))
+ field_match = re.search('\\("' + metric_name + '", "([0-9]+)"\\)', stats_file_contents)
+ if field_match is None:
+ print('Failed to find metric: ', metric_name)
+ raise Exception(failBecause("No such metric"))
+ else:
+ val = field_match.group(1)
+ assert val is not None
+ return int(val)
+
+
+ collect_stat = {}
for metric_name in metrics:
+ def action_generator(mn):
+ return lambda way: read_stats_file(way, mn)
metric = '{}/{}'.format(tag, metric_name)
- def baselineByWay(way, target_commit, metric=metric):
- return Perf.baseline_metric( \
- target_commit, name, config.test_env, metric, way, \
- config.baseline_commit )
+ collect_stat[metric] = { "deviation": deviation
+ , "action": action_generator(metric_name) }
- opts.stats_range_fields[metric] = MetricOracles(baseline=baselineByWay,
- deviation=deviation)
+ _collect_generic_stat(name, opts, collect_stat)
# -----
@@ -1581,6 +1652,11 @@ async def do_compile(name: TestName,
diff_file_name.unlink()
return failBecause('stderr mismatch', stderr=stderr)
+ opts = getTestOpts()
+ if isGenericStatsTest():
+ statsResult = check_generic_stats(TestName(name), way, opts.generic_stats_test)
+ if badResult(statsResult):
+ return statsResult
# no problems found, this test passed
return passed()
@@ -1717,13 +1793,9 @@ async def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts )
async def warn_and_run( name, way, extra_hc_opts ):
return await compile_and_run__( name, way, None, [], extra_hc_opts, compile_stderr = True)
-def stats( name, way, stats_file ):
- opts = getTestOpts()
- return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields)
-
-async def static_stats( name, way, stats_file ):
+async def static_stats( name, way ):
opts = getTestOpts()
- return check_stats(name, way, in_statsdir(stats_file), opts.stats_range_fields)
+ return check_generic_stats(name, way, opts.generic_stats_test)
def metric_dict(name, way, metric, value) -> PerfStat:
return Perf.PerfStat(
@@ -1733,75 +1805,58 @@ def metric_dict(name, way, metric, value) -> PerfStat:
metric = metric,
value = value)
-# -----------------------------------------------------------------------------
-# Check test stats. This prints the results for the user.
-# name: name of the test.
-# way: the way.
-# stats_file: the path of the stats_file containing the stats for the test.
-# range_fields: see TestOptions.stats_range_fields
-# Returns a pass/fail object. Passes if the stats are within the expected value ranges.
-# This prints the results for the user.
-def check_stats(name: TestName,
- way: WayName,
- stats_file: Path,
- range_fields: Dict[MetricName, MetricOracles]
- ) -> PassFail:
+
+
+def check_generic_stats(name, way, get_stats):
+ for (metric, gen_stat) in get_stats.items():
+ res = report_stats(name, way, metric, gen_stat)
+ if badResult(res):
+ return res
+ return passed()
+
+def report_stats(name, way, metric, gen_stat):
+ try:
+ actual_val = gen_stat['action'](way)
+ # Metrics can exit early by throwing an Exception with the desired result.
+ # This is used for both failure, and skipping computing the metric.
+ except Exception as e:
+ result = e.args[0]
+ return result
+
head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None
if head_commit is None:
return passed()
result = passed()
- if range_fields:
- try:
- stats_file_contents = stats_file.read_text()
- except IOError as e:
- return failBecause(str(e))
-
- for (metric, baseline_and_dev) in range_fields.items():
- # Remove any metric prefix e.g. "runtime/" and "compile_time/"
- stat_file_metric = metric.split("/")[-1]
- perf_change = None
-
- field_match = re.search('\\("' + stat_file_metric + '", "([0-9]+)"\\)', stats_file_contents)
- if field_match is None:
- print('Failed to find metric: ', stat_file_metric)
- result = failBecause('no such stats metric')
- else:
- val = field_match.group(1)
- assert val is not None
- actual_val = int(val)
-
- # Store the metric so it can later be stored in a git note.
- perf_stat = metric_dict(name, way, metric, actual_val)
-
- # If this is the first time running the benchmark, then pass.
- baseline = baseline_and_dev.baseline(way, head_commit) \
- if Perf.inside_git_repo() else None
- if baseline is None:
- metric_result = passed()
- perf_change = MetricChange.NewMetric
- else:
- tolerance_dev = baseline_and_dev.deviation
- (perf_change, metric_result) = Perf.check_stats_change(
- perf_stat,
- baseline,
- tolerance_dev,
- config.allowed_perf_changes,
- config.verbose >= 4)
-
- t.metrics.append(PerfMetric(change=perf_change, stat=perf_stat, baseline=baseline))
-
- # If any metric fails then the test fails.
- # Note, the remaining metrics are still run so that
- # a complete list of changes can be presented to the user.
- if not metric_result.passed:
- if config.ignore_perf_increases and perf_change == MetricChange.Increase:
- metric_result = passed()
- elif config.ignore_perf_decreases and perf_change == MetricChange.Decrease:
- metric_result = passed()
-
- result = metric_result
-
+ # Store the metric so it can later be stored in a git note.
+ perf_stat = metric_dict(name, way, metric, actual_val)
+
+ # If this is the first time running the benchmark, then pass.
+ baseline = gen_stat['oracle'](way, head_commit) \
+ if Perf.inside_git_repo() else None
+ if baseline is None:
+ metric_result = passed()
+ perf_change = MetricChange.NewMetric
+ else:
+ (perf_change, metric_result) = Perf.check_stats_change(
+ perf_stat,
+ baseline,
+ gen_stat["deviation"],
+ config.allowed_perf_changes,
+ config.verbose >= 4)
+
+ t.metrics.append(PerfMetric(change=perf_change, stat=perf_stat, baseline=baseline))
+
+ # If any metric fails then the test fails.
+ # Note, the remaining metrics are still run so that
+ # a complete list of changes can be presented to the user.
+ if not metric_result.passed:
+ if config.ignore_perf_increases and perf_change == MetricChange.Increase:
+ metric_result = passed()
+ elif config.ignore_perf_decreases and perf_change == MetricChange.Decrease:
+ metric_result = passed()
+
+ result = metric_result
return result
# -----------------------------------------------------------------------------
@@ -1863,8 +1918,8 @@ async def simple_build(name: Union[TestName, str],
else:
to_do = '-c' # just compile
- stats_file = name + '.comp.stats'
if isCompilerStatsTest():
+ stats_file = statsFile(True, name)
# Set a bigger chunk size to reduce variation due to additional under/overflowing
# The tests are attempting to test how much work the compiler is doing by proxy of
# bytes allocated. The additional allocations caused by stack overflow can cause
@@ -1913,10 +1968,6 @@ async def simple_build(name: Union[TestName, str],
stderr_contents = actual_stderr_path.read_text(encoding='UTF-8', errors='replace')
return failBecause('exit code non-0', stderr=stderr_contents)
- if isCompilerStatsTest():
- statsResult = check_stats(TestName(name), way, in_testdir(stats_file), opts.stats_range_fields)
- if badResult(statsResult):
- return statsResult
return passed()
@@ -1953,7 +2004,7 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
# assume we are running a program via ghci. Collect stats
stats_file = None # type: Optional[str]
if isStatsTest() and (not isCompilerStatsTest() or way == 'ghci' or way == 'ghci-opt'):
- stats_file = name + '.stats'
+ stats_file = statsFile(False, name)
stats_args = ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS'
else:
stats_args = ''
@@ -1999,11 +2050,13 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
if check_prof and not await check_prof_ok(name, way):
return failBecause('bad profile')
- # Check runtime stats if desired.
- if stats_file is not None:
- return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields)
- else:
- return passed()
+ # Check the results of stats tests
+ if isGenericStatsTest():
+ statsResult = check_generic_stats(TestName(name), way, opts.generic_stats_test)
+ if badResult(statsResult):
+ return statsResult
+
+ return passed()
def rts_flags(way: WayName) -> str:
args = config.way_rts_flags.get(way, [])
=====================================
testsuite/tests/count-deps/Makefile
=====================================
@@ -16,8 +16,10 @@ LIBDIR := "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
.PHONY: count-deps-parser
count-deps-parser:
- $(COUNT_DEPS) $(LIBDIR) "GHC.Parser"
+ $(COUNT_DEPS) $(LIBDIR) "GHC.Parser" | tee out
+ cat out | tail -n +2 | wc -l > SIZE
.PHONY: count-deps-ast
count-deps-ast:
- $(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax"
+ $(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax" | tee out
+ cat out | tail -n +2 | wc -l > SIZE
=====================================
testsuite/tests/count-deps/all.T
=====================================
@@ -1,2 +1,2 @@
-test('CountDepsAst', [req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-ast'])
-test('CountDepsParser', [req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-parser'])
+test('CountDepsAst', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-ast'])
+test('CountDepsParser', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-parser'])
=====================================
testsuite/tests/perf/haddock/all.T
=====================================
@@ -19,21 +19,21 @@
test('haddock.base',
[unless(in_tree_compiler(), skip), req_haddock
- ,collect_stats('bytes allocated',5)
+ ,collect_stats('bytes allocated',5, static_stats_file='base.t')
],
static_stats,
- ['base.t'])
+ [])
test('haddock.Cabal',
[unless(in_tree_compiler(), skip), req_haddock
- ,collect_stats('bytes allocated',5)
+ ,collect_stats('bytes allocated',5, static_stats_file='Cabal.t')
],
static_stats,
- ['Cabal.t'])
+ [])
test('haddock.compiler',
[unless(in_tree_compiler(), skip), req_haddock
- ,collect_stats('bytes allocated',10)
+ ,collect_stats('bytes allocated',10, static_stats_file='ghc.t')
],
static_stats,
- ['ghc.t'])
+ [])
=====================================
testsuite/tests/perf/size/Makefile
=====================================
@@ -0,0 +1,7 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+libdir_size:
+ du -s `$(TEST_HC) --print-libdir` | cut -f1 > SIZE
+
=====================================
testsuite/tests/perf/size/all.T
=====================================
@@ -0,0 +1,3 @@
+test('size_hello', [collect_size(3, 'size_hello.o')], compile, [''])
+
+test('libdir',[stat_from_file('size', 3, 'SIZE')], makefile_test, ['libdir_size'] )
=====================================
testsuite/tests/perf/size/size_hello.hs
=====================================
@@ -0,0 +1,3 @@
+module Main where
+
+main = print "Hello World!"
=====================================
utils/check-exact/Orphans.hs
=====================================
@@ -5,65 +5,61 @@ module Orphans where
import GHC hiding (EpaComment)
--- ---------------------------------------------------------------------
--- Orphan NoAnn instances. See https://gitlab.haskell.org/ghc/ghc/-/issues/20372
+-- -- ---------------------------------------------------------------------
instance NoAnn [a] where
noAnn = []
-instance NoAnn AnnPragma where
- noAnn = AnnPragma noAnn noAnn noAnn
-
-instance NoAnn EpAnnImportDecl where
- noAnn = EpAnnImportDecl noAnn Nothing Nothing Nothing Nothing Nothing
+instance (NoAnn a, NoAnn b) => NoAnn (a, b) where
+ noAnn = (noAnn, noAnn)
-instance NoAnn AnnParen where
- noAnn = AnnParen AnnParens noAnn noAnn
+instance NoAnn EpaLocation where
+ noAnn = EpaDelta (SameLine 0) []
-instance NoAnn HsRuleAnn where
- noAnn = HsRuleAnn Nothing Nothing noAnn
+instance NoAnn EpAnnSumPat where
+ noAnn = EpAnnSumPat [] [] []
-instance NoAnn AnnSig where
- noAnn = AnnSig noAnn noAnn
+instance NoAnn AnnPragma where
+ noAnn = AnnPragma noAnn noAnn []
-instance NoAnn GrhsAnn where
- noAnn = GrhsAnn Nothing noAnn
+instance NoAnn AddEpAnn where
+ noAnn = AddEpAnn noAnn noAnn
-instance NoAnn EpAnnUnboundVar where
- noAnn = EpAnnUnboundVar noAnn noAnn
+instance NoAnn AnnKeywordId where
+ noAnn = Annlarrowtail {- gotta pick one -}
-instance (NoAnn a, NoAnn b) => NoAnn (a, b) where
- noAnn = (noAnn, noAnn)
+instance NoAnn AnnParen where
+ noAnn = AnnParen AnnParens noAnn noAnn
-instance NoAnn AnnExplicitSum where
- noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
+instance NoAnn AnnsIf where
+ noAnn = AnnsIf noAnn noAnn noAnn Nothing Nothing
instance NoAnn EpAnnHsCase where
noAnn = EpAnnHsCase noAnn noAnn noAnn
-instance NoAnn AnnsIf where
- noAnn = AnnsIf noAnn noAnn noAnn noAnn noAnn
-
-instance NoAnn (Maybe a) where
- noAnn = Nothing
+instance NoAnn AnnFieldLabel where
+ noAnn = AnnFieldLabel Nothing
instance NoAnn AnnProjection where
noAnn = AnnProjection noAnn noAnn
-instance NoAnn AnnFieldLabel where
- noAnn = AnnFieldLabel Nothing
+instance NoAnn AnnExplicitSum where
+ noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
-instance NoAnn EpaLocation where
- noAnn = EpaDelta (SameLine 0) []
+instance NoAnn EpAnnUnboundVar where
+ noAnn = EpAnnUnboundVar noAnn noAnn
-instance NoAnn AddEpAnn where
- noAnn = AddEpAnn noAnn noAnn
+instance NoAnn GrhsAnn where
+ noAnn = GrhsAnn Nothing noAnn
-instance NoAnn AnnKeywordId where
- noAnn = Annlarrowtail {- gotta pick one -}
+instance NoAnn HsRuleAnn where
+ noAnn = HsRuleAnn Nothing Nothing noAnn
-instance NoAnn EpAnnSumPat where
- noAnn = EpAnnSumPat noAnn noAnn noAnn
+instance NoAnn AnnSig where
+ noAnn = AnnSig noAnn noAnn
+
+instance NoAnn EpAnnImportDecl where
+ noAnn = EpAnnImportDecl noAnn Nothing Nothing Nothing Nothing Nothing
instance NoAnn AnnsModule where
- noAnn = AnnsModule [] mempty Nothing
+ noAnn = AnnsModule [] [] Nothing
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2501357cd055978a6ac944034b04824f9131c59a...294f189f72dde6731e825911c9ca190bba250e88
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2501357cd055978a6ac944034b04824f9131c59a...294f189f72dde6731e825911c9ca190bba250e88
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/20231119/3a387c64/attachment-0001.html>
More information about the ghc-commits
mailing list