try to deal with CI memory overload

Author: majocha

src/Compiler/Checking/import.fs

@@ -106,10 +106,10 @@ let getOrCreateTypeSubsumptionCache =
                     | CompilationMode.OneOff ->
                         // This is a one-off compilation, so we don't need to worry about eviction.
                         { CacheOptions.Default with
-                            MaximumCapacity = 200_000
+                            MaximumCapacity = 4 * 1024
                             EvictionMethod = EvictionMethod.NoEviction }
                     | _ ->
-                        // Oncremental use, so we need to set up the cache with eviction.
+                        // Incremental use, so we need to set up the cache with eviction.
                         { CacheOptions.Default with
                             EvictionMethod = EvictionMethod.Background
                             PercentageToEvict = 5

src/Compiler/Utilities/Caches.fs

@@ -10,7 +10,6 @@ open System.Diagnostics.Metrics
 
 [<Struct; RequireQualifiedAccess; NoComparison>]
 type EvictionMethod =
-    | Blocking
     | Background
     | NoEviction
 
@@ -28,7 +27,7 @@ type CacheOptions =
             MaximumCapacity = 1024
             PercentageToEvict = 5
             LevelOfConcurrency = Environment.ProcessorCount
-            EvictionMethod = EvictionMethod.Blocking
+            EvictionMethod = EvictionMethod.Background
         }
 
 [<Sealed; NoComparison; NoEquality>]
@@ -219,9 +218,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
             false
 
     member _.TryAdd(key: 'Key, value: 'Value) =
-        if options.EvictionMethod.IsBlocking then
-            tryEvictItems ()
-
         let cachedEntity = pool.Acquire(key, value)
 
         if store.TryAdd(key, cachedEntity) then
@@ -232,9 +228,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
             false
 
     member _.AddOrUpdate(key: 'Key, value: 'Value) =
-        if options.EvictionMethod.IsBlocking then
-            tryEvictItems ()
-
         let aquired = pool.Acquire(key, value)
 
         let entity =
@@ -277,17 +270,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
 
     override this.Finalize() : unit = this.Dispose()
 
-    static member Create<'Key, 'Value>(options: CacheOptions) =
-        // Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
-        let capacity =
-            options.MaximumCapacity
-            + int (float options.MaximumCapacity * float options.PercentageToEvict / 100.0)
-
-        let cts = new CancellationTokenSource()
-        let cache = new Cache<'Key, 'Value>(options, capacity, cts)
-        CacheInstrumentation.AddInstrumentation cache |> ignore
-        cache
-
     member this.GetStats() = CacheInstrumentation.GetStats(this)
 
 and CacheInstrumentation(cache: ICacheEvents) =
@@ -382,3 +364,31 @@ and CacheInstrumentation(cache: ICacheEvents) =
     static member RemoveInstrumentation(cache: ICacheEvents) =
         instrumentedCaches[cache].Dispose()
         instrumentedCaches.TryRemove(cache) |> ignore
+
+module Cache =
+
+    // During testing a lot of compilations are started in app domains and subprocesses.
+    // This is a reliable way to pass the override to all of them.
+    [<Literal>]
+    let private overrideVariable = "FSHARP_CACHE_OVERRIDE"
+
+    /// Use for testing purposes to reduce memory consumption in testhost and its subprocesses.
+    let OverrideMaxCapacityForTesting () =
+        Environment.SetEnvironmentVariable(overrideVariable, "true", EnvironmentVariableTarget.Process)
+
+    let Create<'Key, 'Value when 'Key: not null and 'Key: equality> (options: CacheOptions) =
+
+        let options =
+            match Environment.GetEnvironmentVariable(overrideVariable) with
+            | null -> options
+            | _ -> { options with MaximumCapacity = 8 * 1024 }
+
+        // Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
+        let capacity =
+            options.MaximumCapacity
+            + int (float options.MaximumCapacity * float options.PercentageToEvict / 100.0)
+
+        let cts = new CancellationTokenSource()
+        let cache = new Cache<'Key, 'Value>(options, capacity, cts)
+        CacheInstrumentation.AddInstrumentation cache |> ignore
+        cache

src/Compiler/Utilities/Caches.fsi

@@ -5,7 +5,6 @@ open System.Threading
 
 [<Struct; RequireQualifiedAccess; NoComparison>]
 type internal EvictionMethod =
-    | Blocking
     | Background
     | NoEviction
 
@@ -63,8 +62,6 @@ type internal Cache<'Key, 'Value when 'Key: not null and 'Key: equality> =
     member Dispose: unit -> unit
     member GetStats: unit -> string
 
-    static member Create<'Key, 'Value> : options: CacheOptions -> Cache<'Key, 'Value>
-
     interface ICacheEvents
     interface IDisposable
 
@@ -77,3 +74,7 @@ type internal CacheInstrumentation =
     static member GetStatsUpdateForAllCaches: clearCounts: bool -> string
     static member AddInstrumentation: cache: ICacheEvents -> unit
     static member RemoveInstrumentation: cache: ICacheEvents -> unit
+
+module internal Cache =
+    val OverrideMaxCapacityForTesting: unit -> unit
+    val Create<'Key, 'Value when 'Key: not null and 'Key: equality> : options: CacheOptions -> Cache<'Key, 'Value>

tests/FSharp.Test.Utilities/XunitHelpers.fs

@@ -145,6 +145,11 @@ type FSharpXunitFramework(sink: IMessageSink) =
                 // We need AssemblyResolver already here, because OpenTelemetry loads some assemblies dynamically.
                 AssemblyResolver.addResolver ()
             #endif
+
+                // Override cache capacity to reduce memory usage in CI.
+                FSharp.Compiler.Cache.OverrideMaxCapacityForTesting()
+
+                let testRunName = $"RunTests_{assemblyName.Name} {Runtime.InteropServices.RuntimeInformation.FrameworkDescription}"
 
                 // On Windows forwarding localhost to wsl2 docker container sometimes does not work. Use IP address instead.
                 let otlpEndpoint = Uri("http://127.0.0.1:4317")
@@ -167,7 +172,8 @@ type FSharpXunitFramework(sink: IMessageSink) =
                 use meterProvider =
                     OpenTelemetry.Sdk.CreateMeterProviderBuilder()
                         .AddMeter(nameof FSharp.Compiler.CacheInstrumentation)
-                        .ConfigureResource(fun r -> r.AddService("F#") |> ignore)
+                        .AddMeter("System.Runtime")
+                        .ConfigureResource(fun r -> r.AddService(testRunName) |> ignore)
                         .AddOtlpExporter(fun e m ->
                             e.Endpoint <- otlpEndpoint
                             e.Protocol <- OpenTelemetry.Exporter.OtlpExportProtocol.Grpc
@@ -180,7 +186,7 @@ type FSharpXunitFramework(sink: IMessageSink) =
                 TestConsole.install()
 
                 begin
-                    use _ = Activity.startNoTags $"RunTests_{assemblyName.Name} {Runtime.InteropServices.RuntimeInformation.FrameworkDescription}"
+                    use _ = Activity.startNoTags testRunName
                     // We can't just call base.RunTestCases here, because it's implementation is async void.
                     use runner = new XunitTestAssemblyRunner (x.TestAssembly, testCases, x.DiagnosticMessageSink, executionMessageSink, executionOptions)
                     runner.RunAsync().Wait()

vsintegration/src/FSharp.Editor/Common/Logging.fs

@@ -177,6 +177,7 @@ module FSharpServiceTelemetry =
                 .CreateMeterProviderBuilder()
                 .ConfigureResource(fun r -> r.AddService("F#") |> ignore)
                 .AddMeter(nameof FSharp.Compiler.CacheInstrumentation)
+                .AddMeter("System.Runtime")
                 .AddOtlpExporter(fun e m ->
                     e.Endpoint <- otlpEndpoint
                     m.PeriodicExportingMetricReaderOptions.ExportIntervalMilliseconds <- 1000