Option Strict On Option Explicit On Imports System Imports System.Collections.Generic Imports System.Diagnostics Imports System.Drawing Imports System.Drawing.Imaging Imports System.Globalization Imports System.IO Imports System.Text Imports System.Threading.Tasks Imports System.Windows.Forms Imports Nexamas.UI.Application Imports SkiaSharp Partial Friend Class NexamasUIShowcase Private NotInheritable Class RuntimeSmokeOptions Friend Property Enabled As Boolean Friend Property ReportPath As String Friend Property EvidenceDirectory As String Friend Property CaptureScreenshots As Boolean Friend Property ExpectedDpiScale As Nullable(Of Single) Friend Property CheckpointPath As String Friend Property SettleMilliseconds As Integer = 120 Friend Property OnlyRouteId As String End Class Private NotInheritable Class RuntimeSmokeRoute Friend Sub New(routeId As String, routeKind As String) Me.RouteId = If(routeId, String.Empty) Me.RouteKind = If(routeKind, String.Empty) End Sub Friend ReadOnly Property RouteId As String Friend ReadOnly Property RouteKind As String End Class Private NotInheritable Class RuntimeSmokeSizeResult Friend Property Name As String Friend Property Width As Integer Friend Property Height As Integer Friend Property SurfaceWidthPx As Integer Friend Property SurfaceHeightPx As Integer Friend Property ViewportWidthPx As Single Friend Property ViewportHeightPx As Single Friend Property Passed As Boolean Friend Property Failure As String End Class Private NotInheritable Class RuntimeSmokeRouteResult Friend Property RouteId As String Friend Property RouteKind As String Friend Property CurrentPageId As String Friend Property CurrentPageTitle As String Friend Property NavigationSucceeded As Boolean Friend Property ControlsCount As Integer Friend Property DpiScale As Single Friend Property DurationMilliseconds As Long Friend Property BoundaryFailureDelta As Integer Friend Property LifecycleBreakingDelta As Integer Friend Property CriticalStateTransitionDelta As Integer Friend Property LayoutFailureCount As Integer Friend Property ScreenshotPath As String Friend Property Passed As Boolean Friend Property Failure As String Friend Property DiagnosticDetails As String Friend ReadOnly Property Sizes As New List(Of RuntimeSmokeSizeResult)() End Class Private NotInheritable Class RuntimeSmokeReport Friend Property StartedUtc As DateTimeOffset Friend Property CompletedUtc As DateTimeOffset Friend Property Status As String Friend Property Failure As String Friend Property ExpectedDpiScale As Nullable(Of Single) Friend Property ObservedDpiScale As Single Friend Property ObservedHostDeviceDpiScale As Single Friend Property HostClosePassed As Boolean Friend Property HostWindowDisposed As Boolean Friend Property ApplicationDisposed As Boolean Friend Property LifetimeWindowOpened As Boolean Friend Property LifetimeWindowCleaned As Boolean Friend Property CapabilityRouteCount As Integer Friend Property GuidedStepRouteCount As Integer Friend Property CategoryRouteCount As Integer Friend Property ScreenshotCount As Integer Friend Property BaselineBoundaryFailures As Integer Friend Property FinalBoundaryFailures As Integer Friend Property BaselineLifecycleBreaking As Integer Friend Property FinalLifecycleBreaking As Integer Friend Property BaselineCriticalStateTransitions As Integer Friend Property FinalCriticalStateTransitions As Integer Friend ReadOnly Property Routes As New List(Of RuntimeSmokeRouteResult)() End Class Private _runtimeSmokeOptions As RuntimeSmokeOptions Private _runtimeSmokeReport As RuntimeSmokeReport Private _runtimeSmokeStarted As Boolean Private _runtimeSmokeAwaitingHostClose As Boolean Private _runtimeSmokeCurrentRouteId As String = String.Empty Private _runtimeSmokeLayoutFailureCount As Integer Private _runtimeSmokeLayoutFailureDetail As String = String.Empty Private _runtimeSmokeLayoutFailureHandler As EventHandler Private _runtimeSmokeHostWindowReference As MASApplicationWindow Private _runtimeSmokeApplicationReference As MASApplication Private Sub InitializeRuntimeSmokeFromCommandLine() If _runtimeSmokeOptions IsNot Nothing Then Return Dim args As String() = Environment.GetCommandLineArgs() Dim options As New RuntimeSmokeOptions() Dim index As Integer = 1 While index < args.Length Dim argument As String = If(args(index), String.Empty).Trim() Select Case argument.ToLowerInvariant() Case "--runtime-smoke" options.Enabled = True Case "--capture-screenshots" options.CaptureScreenshots = True Case "--report" If index + 1 < args.Length Then index += 1 options.ReportPath = args(index) End If Case "--evidence-dir" If index + 1 < args.Length Then index += 1 options.EvidenceDirectory = args(index) End If Case "--expected-dpi" If index + 1 < args.Length Then index += 1 Dim parsedDpi As Single If Single.TryParse(args(index), NumberStyles.Float, CultureInfo.InvariantCulture, parsedDpi) Then options.ExpectedDpiScale = parsedDpi End If End If Case "--checkpoint" If index + 1 < args.Length Then index += 1 options.CheckpointPath = args(index) End If Case "--settle-ms" If index + 1 < args.Length Then index += 1 Dim parsedMilliseconds As Integer If Integer.TryParse(args(index), NumberStyles.Integer, CultureInfo.InvariantCulture, parsedMilliseconds) Then options.SettleMilliseconds = Math.Max(20, Math.Min(2000, parsedMilliseconds)) End If End If Case "--only-route" If index + 1 < args.Length Then index += 1 options.OnlyRouteId = If(args(index), String.Empty).Trim() End If End Select index += 1 End While If Not options.Enabled Then Return If String.IsNullOrWhiteSpace(options.ReportPath) Then options.ReportPath = Path.Combine( Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Nexamas", "Showcase", "runtime-smoke-report.json") End If If String.IsNullOrWhiteSpace(options.EvidenceDirectory) Then options.EvidenceDirectory = Path.Combine(Path.GetDirectoryName(options.ReportPath), "screenshots") End If If String.IsNullOrWhiteSpace(options.CheckpointPath) Then options.CheckpointPath = Path.Combine(Path.GetDirectoryName(options.ReportPath), "runtime-smoke-checkpoint.txt") End If options.ReportPath = Path.GetFullPath(options.ReportPath) options.EvidenceDirectory = Path.GetFullPath(options.EvidenceDirectory) options.CheckpointPath = Path.GetFullPath(options.CheckpointPath) _runtimeSmokeOptions = options End Sub Protected Overrides Sub OnShown(e As EventArgs) MyBase.OnShown(e) If _runtimeSmokeOptions Is Nothing Then InitializeRuntimeSmokeFromCommandLine() If _runtimeSmokeOptions Is Nothing OrElse Not _runtimeSmokeOptions.Enabled OrElse _runtimeSmokeStarted Then Return _runtimeSmokeStarted = True BeginInvoke(New MethodInvoker(AddressOf BeginRuntimeSmoke)) End Sub Private Async Sub BeginRuntimeSmoke() _runtimeSmokeReport = New RuntimeSmokeReport() With { .StartedUtc = DateTimeOffset.UtcNow, .Status = "RUNNING", .ExpectedDpiScale = _runtimeSmokeOptions.ExpectedDpiScale } Try Directory.CreateDirectory(Path.GetDirectoryName(_runtimeSmokeOptions.ReportPath)) If _runtimeSmokeOptions.CaptureScreenshots Then Directory.CreateDirectory(_runtimeSmokeOptions.EvidenceDirectory) WriteRuntimeSmokeCheckpoint("startup.warmup") ' Let the first native SKGLControl frame and OpenGL surface settle through the ' normal WinForms message loop. The smoke must not force a synchronous paint ' while the child GL surface is still being created or resized. Await Task.Delay(Math.Max(250, _runtimeSmokeOptions.SettleMilliseconds * 2)) If Window Is Nothing OrElse ApplicationFacade Is Nothing Then Throw New InvalidOperationException("The runtime smoke started before the Nexamas.UI application window was ready.") End If _runtimeSmokeHostWindowReference = Window _runtimeSmokeApplicationReference = ApplicationFacade Dim baselineDiagnostics As MASApplicationDiagnosticsSnapshot = MASApplication.Diagnostics.GetSnapshot() Dim baselineBoundaryFailures As Integer = GetBlockingBoundaryFailureCount(baselineDiagnostics) _runtimeSmokeReport.BaselineBoundaryFailures = baselineBoundaryFailures _runtimeSmokeReport.BaselineLifecycleBreaking = baselineDiagnostics.LifecycleBreakingCount _runtimeSmokeReport.BaselineCriticalStateTransitions = baselineDiagnostics.CriticalStateTransitionCount _runtimeSmokeReport.ObservedDpiScale = Window.Geometry.Dpi _runtimeSmokeReport.ObservedHostDeviceDpiScale = ResolveHostDeviceDpiScale() If baselineBoundaryFailures > 0 OrElse baselineDiagnostics.LifecycleBreakingCount > 0 OrElse baselineDiagnostics.CriticalStateTransitionCount > 0 Then Throw New InvalidOperationException( "Startup diagnostics were not clean. Boundary=" & baselineBoundaryFailures.ToString(CultureInfo.InvariantCulture) & ", Lifecycle=" & baselineDiagnostics.LifecycleBreakingCount.ToString(CultureInfo.InvariantCulture) & ", Critical=" & baselineDiagnostics.CriticalStateTransitionCount.ToString(CultureInfo.InvariantCulture) & ". Faults: " & DescribeBlockingDiagnostics(baselineDiagnostics)) End If If _runtimeSmokeOptions.ExpectedDpiScale.HasValue Then Dim expected As Single = _runtimeSmokeOptions.ExpectedDpiScale.Value Dim hostDifference As Single = Math.Abs(_runtimeSmokeReport.ObservedHostDeviceDpiScale - expected) If hostDifference > 0.03F Then Throw New InvalidOperationException( "Expected DPI scale " & expected.ToString("0.###", CultureInfo.InvariantCulture) & " but the WinForms host DeviceDpi reported " & _runtimeSmokeReport.ObservedHostDeviceDpiScale.ToString("0.###", CultureInfo.InvariantCulture) & " and Nexamas.UI Geometry.Dpi reported " & Window.Geometry.Dpi.ToString("0.###", CultureInfo.InvariantCulture) & ".") End If Dim publicDifference As Single = Math.Abs(Window.Geometry.Dpi - expected) If publicDifference > 0.03F Then Throw New InvalidOperationException( "The WinForms host reported the expected DPI scale " & expected.ToString("0.###", CultureInfo.InvariantCulture) & " but Nexamas.UI Geometry.Dpi reported " & Window.Geometry.Dpi.ToString("0.###", CultureInfo.InvariantCulture) & ".") End If End If _runtimeSmokeLayoutFailureHandler = AddressOf HandleRuntimeSmokeLayoutFailure AddHandler Window.Controls.LayoutRefreshFailed, _runtimeSmokeLayoutFailureHandler Dim routes As List(Of RuntimeSmokeRoute) = BuildRuntimeSmokeRoutes() For Each route As RuntimeSmokeRoute In routes WriteRuntimeSmokeCheckpoint("route.begin", route.RouteId) Dim result As RuntimeSmokeRouteResult = Await ExerciseRuntimeSmokeRouteAsync(route) WriteRuntimeSmokeCheckpoint("route.end", route.RouteId) _runtimeSmokeReport.Routes.Add(result) Next Dim finalDiagnostics As MASApplicationDiagnosticsSnapshot = MASApplication.Diagnostics.GetSnapshot() _runtimeSmokeReport.FinalBoundaryFailures = GetBlockingBoundaryFailureCount(finalDiagnostics) _runtimeSmokeReport.FinalLifecycleBreaking = finalDiagnostics.LifecycleBreakingCount _runtimeSmokeReport.FinalCriticalStateTransitions = finalDiagnostics.CriticalStateTransitionCount Dim failedRouteCount As Integer = 0 For Each result As RuntimeSmokeRouteResult In _runtimeSmokeReport.Routes If Not result.Passed Then failedRouteCount += 1 Next If failedRouteCount > 0 Then _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = failedRouteCount.ToString(CultureInfo.InvariantCulture) & " runtime route(s) failed." ElseIf _runtimeSmokeReport.FinalBoundaryFailures > _runtimeSmokeReport.BaselineBoundaryFailures Then _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = "Nexamas.UI boundary failures increased during the runtime smoke." ElseIf _runtimeSmokeReport.FinalLifecycleBreaking > _runtimeSmokeReport.BaselineLifecycleBreaking Then _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = "Nexamas.UI lifecycle-breaking diagnostics increased during the runtime smoke." ElseIf _runtimeSmokeReport.FinalCriticalStateTransitions > _runtimeSmokeReport.BaselineCriticalStateTransitions Then _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = "Nexamas.UI critical-state diagnostics increased during the runtime smoke." Else _runtimeSmokeReport.Status = "PASS_PENDING_HOST_CLOSE" End If Catch ex As Exception _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = ex.GetType().FullName & ": " & ex.Message Finally If Window IsNot Nothing AndAlso _runtimeSmokeLayoutFailureHandler IsNot Nothing Then RemoveHandler Window.Controls.LayoutRefreshFailed, _runtimeSmokeLayoutFailureHandler _runtimeSmokeLayoutFailureHandler = Nothing End If _runtimeSmokeReport.CompletedUtc = DateTimeOffset.UtcNow WriteRuntimeSmokeCheckpoint("host.close") _runtimeSmokeAwaitingHostClose = True Close() End Try End Sub Private Async Function ExerciseRuntimeSmokeRouteAsync(route As RuntimeSmokeRoute) As Task(Of RuntimeSmokeRouteResult) Dim result As New RuntimeSmokeRouteResult() With { .RouteId = route.RouteId, .RouteKind = route.RouteKind } Dim stopwatch As Stopwatch = Stopwatch.StartNew() Dim beforeDiagnostics As MASApplicationDiagnosticsSnapshot = MASApplication.Diagnostics.GetSnapshot() _runtimeSmokeCurrentRouteId = route.RouteId _runtimeSmokeLayoutFailureCount = 0 _runtimeSmokeLayoutFailureDetail = String.Empty Try WriteRuntimeSmokeCheckpoint("route.navigate", route.RouteId) Dim navigateResult As Boolean = Window.Pages.NavigateTo(route.RouteId) Await SettleRuntimeSmokeAsync() result.CurrentPageId = Window.Pages.CurrentPageId result.CurrentPageTitle = Window.Pages.CurrentPageTitle result.NavigationSucceeded = navigateResult OrElse String.Equals(result.CurrentPageId, route.RouteId, StringComparison.OrdinalIgnoreCase) If Not result.NavigationSucceeded Then Throw New InvalidOperationException("NavigateTo returned False and CurrentPageId did not match the requested route.") End If result.ControlsCount = Window.Controls.Count result.DpiScale = Window.Geometry.Dpi If result.ControlsCount <= 0 Then Throw New InvalidOperationException("The route left the Nexamas.UI control collection empty.") End If For Each sizeCase As KeyValuePair(Of String, Size) In BuildRuntimeSmokeWindowSizes() WriteRuntimeSmokeCheckpoint("route.resize." & sizeCase.Key, route.RouteId) Dim sizeResult As RuntimeSmokeSizeResult = Await ExerciseRuntimeSmokeSizeAsync(sizeCase.Key, sizeCase.Value) result.Sizes.Add(sizeResult) If Not sizeResult.Passed AndAlso String.IsNullOrWhiteSpace(result.Failure) Then result.Failure = sizeResult.Failure End If Next If _runtimeSmokeOptions.CaptureScreenshots AndAlso (String.Equals(route.RouteKind, "Capability", StringComparison.OrdinalIgnoreCase) OrElse String.Equals(route.RouteKind, "Home", StringComparison.OrdinalIgnoreCase)) Then WriteRuntimeSmokeCheckpoint("route.screenshot", route.RouteId) result.ScreenshotPath = CaptureRuntimeSmokeScreenshot(route.RouteId) If String.IsNullOrWhiteSpace(result.ScreenshotPath) Then result.Failure = AppendFailure(result.Failure, "Screenshot capture was requested but no PNG evidence was written.") Else _runtimeSmokeReport.ScreenshotCount += 1 End If End If If String.Equals(route.RouteId, "showcase.open.application.lifetime", StringComparison.OrdinalIgnoreCase) Then Await ExerciseRuntimeSmokeLifetimeAsync() End If Dim afterDiagnostics As MASApplicationDiagnosticsSnapshot = MASApplication.Diagnostics.GetSnapshot() result.BoundaryFailureDelta = GetBlockingBoundaryFailureCount(afterDiagnostics) - GetBlockingBoundaryFailureCount(beforeDiagnostics) result.LifecycleBreakingDelta = afterDiagnostics.LifecycleBreakingCount - beforeDiagnostics.LifecycleBreakingCount result.CriticalStateTransitionDelta = afterDiagnostics.CriticalStateTransitionCount - beforeDiagnostics.CriticalStateTransitionCount result.LayoutFailureCount = _runtimeSmokeLayoutFailureCount If result.BoundaryFailureDelta > 0 OrElse result.LifecycleBreakingDelta > 0 OrElse result.CriticalStateTransitionDelta > 0 Then result.DiagnosticDetails = DescribeBlockingDiagnostics(afterDiagnostics) End If If result.BoundaryFailureDelta > 0 Then result.Failure = AppendFailure(result.Failure, "Boundary diagnostics increased.") If result.LifecycleBreakingDelta > 0 Then result.Failure = AppendFailure(result.Failure, "Lifecycle-breaking diagnostics increased.") If result.CriticalStateTransitionDelta > 0 Then result.Failure = AppendFailure(result.Failure, "Critical-state diagnostics increased.") If result.LayoutFailureCount > 0 Then result.Failure = AppendFailure(result.Failure, "Layout refresh failure: " & _runtimeSmokeLayoutFailureDetail) result.Passed = String.IsNullOrWhiteSpace(result.Failure) Catch ex As Exception result.Failure = AppendFailure(result.Failure, ex.GetType().FullName & ": " & ex.Message) result.Passed = False End Try Try If Window IsNot Nothing AndAlso Not String.Equals(route.RouteId, HomePageId, StringComparison.OrdinalIgnoreCase) Then Window.Pages.NavigateTo(HomePageId) Await SettleRuntimeSmokeAsync() End If If ApplicationFacade IsNot Nothing AndAlso ApplicationFacade.WindowCount <> 1 Then result.Failure = AppendFailure(result.Failure, "Route cleanup left MASApplication.WindowCount=" & ApplicationFacade.WindowCount.ToString(CultureInfo.InvariantCulture) & ".") result.Passed = False End If Catch cleanupException As Exception result.Failure = AppendFailure(result.Failure, "Cleanup failed: " & cleanupException.Message) result.Passed = False End Try stopwatch.Stop() result.DurationMilliseconds = stopwatch.ElapsedMilliseconds Return result End Function Private Async Function ExerciseRuntimeSmokeSizeAsync(name As String, targetSize As Size) As Task(Of RuntimeSmokeSizeResult) Dim result As New RuntimeSmokeSizeResult() With { .Name = name, .Width = targetSize.Width, .Height = targetSize.Height } Try Size = targetSize CenterRuntimeSmokeWindow() Await SettleRuntimeSmokeAsync() ' Page refresh may rebuild retained layout, but painting remains asynchronous. ' Never pair a native resize with forced synchronous painting or a re-entrant ' message pump while the OpenGL surface is being recreated. Window.Pages.Refresh() Await SettleRuntimeSmokeAsync() Dim surfaceSize As SKSizeI = Window.Geometry.SurfaceSizePx Dim viewport As SKRect = Window.Geometry.SurfaceViewportPx() result.SurfaceWidthPx = surfaceSize.Width result.SurfaceHeightPx = surfaceSize.Height result.ViewportWidthPx = viewport.Width result.ViewportHeightPx = viewport.Height If surfaceSize.Width <= 0 OrElse surfaceSize.Height <= 0 Then Throw New InvalidOperationException("SurfaceSizePx is not usable.") End If If Not Window.Geometry.IsUsable(viewport, 1.0F, 1.0F) Then Throw New InvalidOperationException("SurfaceViewportPx is not usable.") End If If Window.Controls.HasLastLayoutRefreshFailure Then Throw New InvalidOperationException( "Last layout refresh failure: " & Window.Controls.LastLayoutRefreshFailureCode & " · " & Window.Controls.LastLayoutRefreshFailureMessage) End If result.Passed = True Catch ex As Exception result.Passed = False result.Failure = ex.GetType().FullName & ": " & ex.Message End Try Return result End Function Private Async Function ExerciseRuntimeSmokeLifetimeAsync() As Task Dim baselineWindowCount As Integer = ApplicationFacade.WindowCount Dim lifetime As IDisposable = Nothing Try lifetime = ShowcasePageHostContentBuilder.OpenSecondaryWindowForLifetimeProof( ApplicationFacade, AddressOf RegisterPageLifetime) Await SettleRuntimeSmokeAsync() _runtimeSmokeReport.LifetimeWindowOpened = (ApplicationFacade.WindowCount = baselineWindowCount + 1) If Not _runtimeSmokeReport.LifetimeWindowOpened Then Throw New InvalidOperationException("The secondary lifetime proof did not increase MASApplication.WindowCount.") End If Window.Pages.NavigateTo(HomePageId) Await SettleRuntimeSmokeAsync() _runtimeSmokeReport.LifetimeWindowCleaned = (ApplicationFacade.WindowCount = baselineWindowCount) If Not _runtimeSmokeReport.LifetimeWindowCleaned Then Throw New InvalidOperationException("Navigating away did not dispose the secondary lifetime proof window.") End If Finally If lifetime IsNot Nothing Then lifetime.Dispose() End Try End Function Private Function BuildRuntimeSmokeRoutes() As List(Of RuntimeSmokeRoute) Dim routes As New List(Of RuntimeSmokeRoute)() routes.Add(New RuntimeSmokeRoute(HomePageId, "Home")) routes.Add(New RuntimeSmokeRoute(GuidedJourneyPageId, "GuidedLanding")) For Each category As ShowcaseNavigationCategory In ShowcaseNavigationCatalog.GetCategories() routes.Add(New RuntimeSmokeRoute(ShowcaseNavigationCatalog.ResolveCategoryPageId(category), "Category")) _runtimeSmokeReport.CategoryRouteCount += 1 Next For Each entry As ShowcaseNavigationEntry In ShowcaseNavigationCatalog.GetEntries() routes.Add(New RuntimeSmokeRoute(entry.CommandId, "Capability")) _runtimeSmokeReport.CapabilityRouteCount += 1 Next For Each journeyId As String In New String() {"controls", "systems", "data", "theme", "proof"} Dim journey As GuidedJourneyDefinition = ResolveGuidedJourney(journeyId) If journey Is Nothing OrElse journey.Steps Is Nothing Then Continue For For index As Integer = 0 To journey.Steps.Length - 1 routes.Add(New RuntimeSmokeRoute(ResolveGuidedJourneyStepPageId(journeyId, index), "GuidedStep")) _runtimeSmokeReport.GuidedStepRouteCount += 1 Next Next If Not String.IsNullOrWhiteSpace(_runtimeSmokeOptions.OnlyRouteId) Then Dim filtered As New List(Of RuntimeSmokeRoute)() For Each route As RuntimeSmokeRoute In routes If String.Equals(route.RouteId, _runtimeSmokeOptions.OnlyRouteId, StringComparison.OrdinalIgnoreCase) Then filtered.Add(route) Exit For End If Next If filtered.Count = 0 Then Throw New InvalidOperationException("The requested focused runtime route was not found: " & _runtimeSmokeOptions.OnlyRouteId) End If _runtimeSmokeReport.CapabilityRouteCount = If(String.Equals(filtered(0).RouteKind, "Capability", StringComparison.OrdinalIgnoreCase), 1, 0) _runtimeSmokeReport.GuidedStepRouteCount = If(String.Equals(filtered(0).RouteKind, "GuidedStep", StringComparison.OrdinalIgnoreCase), 1, 0) _runtimeSmokeReport.CategoryRouteCount = If(String.Equals(filtered(0).RouteKind, "Category", StringComparison.OrdinalIgnoreCase), 1, 0) Return filtered End If Return routes End Function Private Function BuildRuntimeSmokeWindowSizes() As List(Of KeyValuePair(Of String, Size)) Dim sizes As New List(Of KeyValuePair(Of String, Size))() Dim workingArea As Rectangle = Screen.FromControl(Me).WorkingArea Dim minimum As Size = MinimumSize Dim standard As Size = ShowcaseConsumerContentContract.CreateInitialWindowSize(ShowcaseWindowSizeKind.Launcher) Dim expanded As New Size(Math.Min(workingArea.Width - 24, Math.Max(standard.Width + 220, minimum.Width)), Math.Min(workingArea.Height - 24, Math.Max(standard.Height + 120, minimum.Height))) standard = ClampRuntimeSmokeSize(standard, workingArea, minimum) minimum = ClampRuntimeSmokeSize(minimum, workingArea, minimum) expanded = ClampRuntimeSmokeSize(expanded, workingArea, minimum) AddRuntimeSmokeSizeIfUnique(sizes, "minimum", minimum) AddRuntimeSmokeSizeIfUnique(sizes, "standard", standard) AddRuntimeSmokeSizeIfUnique(sizes, "expanded", expanded) Return sizes End Function Private Shared Sub AddRuntimeSmokeSizeIfUnique(target As List(Of KeyValuePair(Of String, Size)), name As String, value As Size) For Each existing As KeyValuePair(Of String, Size) In target If existing.Value.Width = value.Width AndAlso existing.Value.Height = value.Height Then Return Next target.Add(New KeyValuePair(Of String, Size)(name, value)) End Sub Private Shared Function ClampRuntimeSmokeSize(value As Size, workingArea As Rectangle, minimum As Size) As Size Dim maximumWidth As Integer = Math.Max(320, workingArea.Width - 24) Dim maximumHeight As Integer = Math.Max(240, workingArea.Height - 24) Return New Size( Math.Min(maximumWidth, Math.Max(Math.Min(minimum.Width, maximumWidth), value.Width)), Math.Min(maximumHeight, Math.Max(Math.Min(minimum.Height, maximumHeight), value.Height))) End Function Private Sub CenterRuntimeSmokeWindow() Dim workingArea As Rectangle = Screen.FromControl(Me).WorkingArea Location = New Point( workingArea.Left + Math.Max(0, (workingArea.Width - Width) \ 2), workingArea.Top + Math.Max(0, (workingArea.Height - Height) \ 2)) BringToFront() Activate() End Sub Private Async Function SettleRuntimeSmokeAsync() As Task If Window Is Nothing OrElse Window.IsDisposed OrElse IsDisposed Then Return ' Request the official asynchronous invalidation route and then yield to the ' WinForms synchronization context. Task.Delay allows resize/paint messages to ' complete naturally without a re-entrant nested message pump. Window.Refresh() Await Task.Delay(_runtimeSmokeOptions.SettleMilliseconds) Await Task.Yield() End Function Private Sub WriteRuntimeSmokeCheckpoint(stage As String, Optional routeId As String = Nothing) If _runtimeSmokeOptions Is Nothing OrElse String.IsNullOrWhiteSpace(_runtimeSmokeOptions.CheckpointPath) Then Return Try Dim directoryPath As String = Path.GetDirectoryName(_runtimeSmokeOptions.CheckpointPath) If Not String.IsNullOrWhiteSpace(directoryPath) Then Directory.CreateDirectory(directoryPath) Dim effectiveRouteId As String = If(routeId, _runtimeSmokeCurrentRouteId) Dim text As String = "UTC=" & DateTimeOffset.UtcNow.ToString("O", CultureInfo.InvariantCulture) & Environment.NewLine & "Stage=" & If(stage, String.Empty) & Environment.NewLine & "Route=" & If(effectiveRouteId, String.Empty) & Environment.NewLine & "WindowSize=" & Width.ToString(CultureInfo.InvariantCulture) & "x" & Height.ToString(CultureInfo.InvariantCulture) File.WriteAllText(_runtimeSmokeOptions.CheckpointPath, text, Encoding.UTF8) Catch ' Checkpoint evidence is diagnostic-only and must never change smoke behavior. End Try End Sub Private Sub HandleRuntimeSmokeLayoutFailure(sender As Object, e As EventArgs) _runtimeSmokeLayoutFailureCount += 1 If Window Is Nothing Then Return _runtimeSmokeLayoutFailureDetail = "route=" & _runtimeSmokeCurrentRouteId & "; code=" & Window.Controls.LastLayoutRefreshFailureCode & "; stage=" & Window.Controls.LastLayoutRefreshFailureStage & "; message=" & Window.Controls.LastLayoutRefreshFailureMessage End Sub Private Function CaptureRuntimeSmokeScreenshot(routeId As String) As String Try Dim safeName As String = CreateRuntimeSmokeFileName(routeId) Dim screenshotPath As String = System.IO.Path.Combine(_runtimeSmokeOptions.EvidenceDirectory, safeName & ".png") BringToFront() Activate() Using bitmap As New Bitmap(Math.Max(1, Width), Math.Max(1, Height), PixelFormat.Format32bppArgb) Using graphics As Graphics = Graphics.FromImage(bitmap) graphics.CopyFromScreen(PointToScreen(Point.Empty), Point.Empty, bitmap.Size, CopyPixelOperation.SourceCopy) End Using bitmap.Save(screenshotPath, ImageFormat.Png) End Using Return screenshotPath Catch ex As Exception Return String.Empty End Try End Function Private Shared Function CreateRuntimeSmokeFileName(routeId As String) As String Dim builder As New StringBuilder() For Each character As Char In If(routeId, String.Empty) If Char.IsLetterOrDigit(character) OrElse character = "-"c OrElse character = "_"c Then builder.Append(character) Else builder.Append("_"c) End If Next Return builder.ToString() End Function Private Shared Function AppendFailure(existing As String, addition As String) As String If String.IsNullOrWhiteSpace(addition) Then Return If(existing, String.Empty) If String.IsNullOrWhiteSpace(existing) Then Return addition Return existing & " | " & addition End Function Private Function IsRuntimeSmokeActive() As Boolean Return _runtimeSmokeOptions IsNot Nothing AndAlso _runtimeSmokeOptions.Enabled End Function Private Sub FinalizeRuntimeSmokeAfterHostClosed(closeFailure As Exception) If Not _runtimeSmokeAwaitingHostClose OrElse _runtimeSmokeReport Is Nothing Then Return _runtimeSmokeAwaitingHostClose = False _runtimeSmokeReport.HostWindowDisposed = (_runtimeSmokeHostWindowReference IsNot Nothing AndAlso _runtimeSmokeHostWindowReference.IsDisposed) _runtimeSmokeReport.ApplicationDisposed = (_runtimeSmokeApplicationReference IsNot Nothing AndAlso _runtimeSmokeApplicationReference.IsDisposed) _runtimeSmokeReport.HostClosePassed = (Window Is Nothing AndAlso ApplicationFacade Is Nothing AndAlso _runtimeSmokeReport.HostWindowDisposed AndAlso _runtimeSmokeReport.ApplicationDisposed) If closeFailure IsNot Nothing Then _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = AppendFailure(_runtimeSmokeReport.Failure, "Host close failed: " & closeFailure.Message) ElseIf Not _runtimeSmokeReport.HostClosePassed Then _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = AppendFailure( _runtimeSmokeReport.Failure, "The host close did not dispose the MASApplicationWindow and shared MASApplication or release their host references.") ElseIf String.Equals(_runtimeSmokeReport.Status, "PASS_PENDING_HOST_CLOSE", StringComparison.Ordinal) Then _runtimeSmokeReport.Status = "PASS" End If _runtimeSmokeReport.CompletedUtc = DateTimeOffset.UtcNow Try WriteRuntimeSmokeReport(_runtimeSmokeOptions.ReportPath, _runtimeSmokeReport) Catch reportException As Exception _runtimeSmokeReport.Status = "FAIL" _runtimeSmokeReport.Failure = AppendFailure(_runtimeSmokeReport.Failure, "Report write failed: " & reportException.Message) End Try WriteRuntimeSmokeCheckpoint("complete") Environment.ExitCode = If(String.Equals(_runtimeSmokeReport.Status, "PASS", StringComparison.Ordinal), 0, 1) End Sub Private Shared Function GetBlockingBoundaryFailureCount(snapshot As MASApplicationDiagnosticsSnapshot) As Integer If snapshot Is Nothing Then Return 0 If snapshot.RecentFaults Is Nothing OrElse snapshot.RecentFaults.Count = 0 Then Return snapshot.BoundaryFailureCount End If Dim blockingCount As Integer = 0 For Each fault As MASApplicationDiagnosticsFaultSummary In snapshot.RecentFaults If fault Is Nothing OrElse Not String.Equals(fault.Severity, "BoundaryFailure", StringComparison.OrdinalIgnoreCase) OrElse IsBenignRecentFaultWindowOverflow(fault) Then Continue For End If blockingCount += 1 Next Return blockingCount End Function Private Shared Function IsBenignRecentFaultWindowOverflow(fault As MASApplicationDiagnosticsFaultSummary) As Boolean If fault Is Nothing OrElse Not String.Equals(fault.Severity, "BoundaryFailure", StringComparison.OrdinalIgnoreCase) OrElse Not String.Equals(fault.Category, "DiagnosticOnly", StringComparison.OrdinalIgnoreCase) OrElse Not String.Equals(fault.Context, "Nexamas.UI.Diagnostics.RecentFaultWindowOverflow", StringComparison.OrdinalIgnoreCase) Then Return False End If Dim message As String = If(fault.Message, String.Empty) If message.IndexOf("LostRecentFaultsSummarized=True", StringComparison.OrdinalIgnoreCase) < 0 OrElse message.IndexOf("EvictedSeverityCounts=Recoverable=", StringComparison.OrdinalIgnoreCase) < 0 Then Return False End If Return message.IndexOf("EvictedSeverityCounts=BoundaryFailure=", StringComparison.OrdinalIgnoreCase) < 0 AndAlso message.IndexOf("EvictedSeverityCounts=CriticalStateTransition=", StringComparison.OrdinalIgnoreCase) < 0 AndAlso message.IndexOf("EvictedCategoryCounts=LifecycleBreaking=", StringComparison.OrdinalIgnoreCase) < 0 End Function Private Shared Function DescribeBlockingDiagnostics(snapshot As MASApplicationDiagnosticsSnapshot) As String If snapshot Is Nothing OrElse snapshot.RecentFaults Is Nothing OrElse snapshot.RecentFaults.Count = 0 Then Return "No retained public fault summaries were available." End If Dim details As New List(Of String)() For Each fault As MASApplicationDiagnosticsFaultSummary In snapshot.RecentFaults If fault Is Nothing Then Continue For Dim blocksStartup As Boolean = (String.Equals(fault.Severity, "BoundaryFailure", StringComparison.OrdinalIgnoreCase) AndAlso Not IsBenignRecentFaultWindowOverflow(fault)) OrElse String.Equals(fault.Severity, "CriticalStateTransition", StringComparison.OrdinalIgnoreCase) OrElse String.Equals(fault.Category, "LifecycleBreaking", StringComparison.OrdinalIgnoreCase) If Not blocksStartup Then Continue For details.Add( "Severity=" & If(fault.Severity, String.Empty) & "; Category=" & If(fault.Category, String.Empty) & "; Context=" & If(fault.Context, String.Empty) & "; Exception=" & If(fault.ExceptionTypeName, String.Empty) & "; Message=" & If(fault.Message, String.Empty) & "; Occurrences=" & fault.OccurrenceCount.ToString(CultureInfo.InvariantCulture) & "; UTC=" & fault.TimestampUtc.ToString("O", CultureInfo.InvariantCulture)) Next If details.Count = 0 Then Dim mostRecent As MASApplicationDiagnosticsFaultSummary = snapshot.MostRecentFault If mostRecent Is Nothing Then Return "No blocking fault summary was retained." Return "MostRecent Severity=" & If(mostRecent.Severity, String.Empty) & "; Category=" & If(mostRecent.Category, String.Empty) & "; Context=" & If(mostRecent.Context, String.Empty) & "; Exception=" & If(mostRecent.ExceptionTypeName, String.Empty) & "; Message=" & If(mostRecent.Message, String.Empty) & "; Occurrences=" & mostRecent.OccurrenceCount.ToString(CultureInfo.InvariantCulture) & "; UTC=" & mostRecent.TimestampUtc.ToString("O", CultureInfo.InvariantCulture) End If Return String.Join(" | ", details.ToArray()) End Function Private Function ResolveHostDeviceDpiScale() As Single Dim deviceDpi As Integer = Me.DeviceDpi If deviceDpi <= 0 Then Return 1.0F Return CSng(Math.Round(CDbl(deviceDpi) / 96.0R, 2)) End Function Private Shared Sub WriteRuntimeSmokeReport(path As String, report As RuntimeSmokeReport) Dim builder As New StringBuilder() builder.AppendLine("{") AppendJsonProperty(builder, "schemaVersion", "1", True, 1) AppendJsonProperty(builder, "product", "Nexamas UI Showcase", True, 1) AppendJsonProperty(builder, "status", report.Status, True, 1) AppendJsonProperty(builder, "failure", report.Failure, True, 1) AppendJsonProperty(builder, "startedUtc", report.StartedUtc.ToString("O", CultureInfo.InvariantCulture), True, 1) AppendJsonProperty(builder, "completedUtc", report.CompletedUtc.ToString("O", CultureInfo.InvariantCulture), True, 1) AppendJsonProperty(builder, "expectedDpiScale", If(report.ExpectedDpiScale.HasValue, report.ExpectedDpiScale.Value.ToString("0.###", CultureInfo.InvariantCulture), Nothing), True, 1, rawNumber:=report.ExpectedDpiScale.HasValue) AppendJsonProperty(builder, "observedDpiScale", report.ObservedDpiScale.ToString("0.###", CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "observedHostDeviceDpiScale", report.ObservedHostDeviceDpiScale.ToString("0.###", CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "hostClosePassed", report.HostClosePassed.ToString().ToLowerInvariant(), True, 1, rawNumber:=True) AppendJsonProperty(builder, "hostWindowDisposed", report.HostWindowDisposed.ToString().ToLowerInvariant(), True, 1, rawNumber:=True) AppendJsonProperty(builder, "applicationDisposed", report.ApplicationDisposed.ToString().ToLowerInvariant(), True, 1, rawNumber:=True) AppendJsonProperty(builder, "lifetimeWindowOpened", report.LifetimeWindowOpened.ToString().ToLowerInvariant(), True, 1, rawNumber:=True) AppendJsonProperty(builder, "lifetimeWindowCleaned", report.LifetimeWindowCleaned.ToString().ToLowerInvariant(), True, 1, rawNumber:=True) AppendJsonProperty(builder, "capabilityRouteCount", report.CapabilityRouteCount.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "guidedStepRouteCount", report.GuidedStepRouteCount.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "categoryRouteCount", report.CategoryRouteCount.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "routeCount", report.Routes.Count.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "screenshotCount", report.ScreenshotCount.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "baselineBoundaryFailures", report.BaselineBoundaryFailures.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "finalBoundaryFailures", report.FinalBoundaryFailures.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "baselineLifecycleBreaking", report.BaselineLifecycleBreaking.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "finalLifecycleBreaking", report.FinalLifecycleBreaking.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "baselineCriticalStateTransitions", report.BaselineCriticalStateTransitions.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) AppendJsonProperty(builder, "finalCriticalStateTransitions", report.FinalCriticalStateTransitions.ToString(CultureInfo.InvariantCulture), True, 1, rawNumber:=True) builder.Append(" ").Append(ChrW(34)).Append("routes").Append(ChrW(34)).AppendLine(": [") For routeIndex As Integer = 0 To report.Routes.Count - 1 Dim route As RuntimeSmokeRouteResult = report.Routes(routeIndex) builder.AppendLine(" {") AppendJsonProperty(builder, "routeId", route.RouteId, True, 3) AppendJsonProperty(builder, "routeKind", route.RouteKind, True, 3) AppendJsonProperty(builder, "currentPageId", route.CurrentPageId, True, 3) AppendJsonProperty(builder, "currentPageTitle", route.CurrentPageTitle, True, 3) AppendJsonProperty(builder, "navigationSucceeded", route.NavigationSucceeded.ToString().ToLowerInvariant(), True, 3, rawNumber:=True) AppendJsonProperty(builder, "controlsCount", route.ControlsCount.ToString(CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "dpiScale", route.DpiScale.ToString("0.###", CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "durationMilliseconds", route.DurationMilliseconds.ToString(CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "boundaryFailureDelta", route.BoundaryFailureDelta.ToString(CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "lifecycleBreakingDelta", route.LifecycleBreakingDelta.ToString(CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "criticalStateTransitionDelta", route.CriticalStateTransitionDelta.ToString(CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "layoutFailureCount", route.LayoutFailureCount.ToString(CultureInfo.InvariantCulture), True, 3, rawNumber:=True) AppendJsonProperty(builder, "screenshotPath", route.ScreenshotPath, True, 3) AppendJsonProperty(builder, "passed", route.Passed.ToString().ToLowerInvariant(), True, 3, rawNumber:=True) AppendJsonProperty(builder, "failure", route.Failure, True, 3) AppendJsonProperty(builder, "diagnosticDetails", route.DiagnosticDetails, True, 3) builder.Append(" ").Append(ChrW(34)).Append("sizes").Append(ChrW(34)).AppendLine(": [") For sizeIndex As Integer = 0 To route.Sizes.Count - 1 Dim sizeResult As RuntimeSmokeSizeResult = route.Sizes(sizeIndex) builder.AppendLine(" {") AppendJsonProperty(builder, "name", sizeResult.Name, True, 5) AppendJsonProperty(builder, "width", sizeResult.Width.ToString(CultureInfo.InvariantCulture), True, 5, rawNumber:=True) AppendJsonProperty(builder, "height", sizeResult.Height.ToString(CultureInfo.InvariantCulture), True, 5, rawNumber:=True) AppendJsonProperty(builder, "surfaceWidthPx", sizeResult.SurfaceWidthPx.ToString(CultureInfo.InvariantCulture), True, 5, rawNumber:=True) AppendJsonProperty(builder, "surfaceHeightPx", sizeResult.SurfaceHeightPx.ToString(CultureInfo.InvariantCulture), True, 5, rawNumber:=True) AppendJsonProperty(builder, "viewportWidthPx", sizeResult.ViewportWidthPx.ToString("0.###", CultureInfo.InvariantCulture), True, 5, rawNumber:=True) AppendJsonProperty(builder, "viewportHeightPx", sizeResult.ViewportHeightPx.ToString("0.###", CultureInfo.InvariantCulture), True, 5, rawNumber:=True) AppendJsonProperty(builder, "passed", sizeResult.Passed.ToString().ToLowerInvariant(), True, 5, rawNumber:=True) AppendJsonProperty(builder, "failure", sizeResult.Failure, False, 5) builder.Append(" }") If sizeIndex < route.Sizes.Count - 1 Then builder.Append(",") builder.AppendLine() Next builder.AppendLine(" ]") builder.Append(" }") If routeIndex < report.Routes.Count - 1 Then builder.Append(",") builder.AppendLine() Next builder.AppendLine(" ]") builder.AppendLine("}") File.WriteAllText(path, builder.ToString(), New UTF8Encoding(encoderShouldEmitUTF8Identifier:=False)) End Sub Private Shared Sub AppendJsonProperty(builder As StringBuilder, name As String, value As String, trailingComma As Boolean, indentLevel As Integer, Optional rawNumber As Boolean = False) builder.Append(New String(" "c, indentLevel * 2)) builder.Append(ChrW(34)).Append(EscapeJson(name)).Append(ChrW(34)).Append(": ") If value Is Nothing Then builder.Append("null") ElseIf rawNumber Then builder.Append(value) Else builder.Append(ChrW(34)).Append(EscapeJson(value)).Append(ChrW(34)) End If If trailingComma Then builder.Append(",") builder.AppendLine() End Sub Private Shared Function EscapeJson(value As String) As String If value Is Nothing Then Return String.Empty Dim builder As New StringBuilder(value.Length + 16) For Each character As Char In value Select Case character Case ChrW(34) builder.Append(ChrW(92)).Append(ChrW(34)) Case ChrW(92) builder.Append(ChrW(92)).Append(ChrW(92)) Case ControlChars.Back builder.Append(ChrW(92)).Append("b"c) Case ControlChars.FormFeed builder.Append(ChrW(92)).Append("f"c) Case ControlChars.Lf builder.Append(ChrW(92)).Append("n"c) Case ControlChars.Cr builder.Append(ChrW(92)).Append("r"c) Case ControlChars.Tab builder.Append(ChrW(92)).Append("t"c) Case Else If AscW(character) < 32 Then builder.Append(ChrW(92)).Append("u"c).Append(AscW(character).ToString("x4", CultureInfo.InvariantCulture)) Else builder.Append(character) End If End Select Next Return builder.ToString() End Function End Class