From 66a426c7cd07b1e72e411a991a5e7a442af58e51 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 22 Aug 2024 17:14:24 +0200 Subject: [PATCH 01/13] tests + initial parsing of HasAllowsRefStruct --- src/Compiler/AbstractIL/il.fs | 2 + src/Compiler/AbstractIL/il.fsi | 3 + src/Compiler/AbstractIL/ilread.fs | 1 + src/Compiler/AbstractIL/ilwrite.fs | 3 +- src/Compiler/CodeGen/IlxGen.fs | 2 + .../Interop/ByrefTests.fs | 56 ++++++++++++++++++- 6 files changed, 65 insertions(+), 2 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 9b8f659f647..f201b896fc1 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1863,6 +1863,7 @@ type ILGenericParameterDef = Constraints: ILTypes Variance: ILGenericVariance HasReferenceTypeConstraint: bool + HasAllowsRefStruct: bool HasNotNullableValueTypeConstraint: bool HasDefaultConstructorConstraint: bool CustomAttrsStored: ILAttributesStored @@ -3283,6 +3284,7 @@ let mkILSimpleTypar nm = HasReferenceTypeConstraint = false HasNotNullableValueTypeConstraint = false HasDefaultConstructorConstraint = false + HasAllowsRefStruct = false CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs MetadataIndex = NoMetadataIdx } diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 1e2a6ee3705..e3ec95a40d7 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -1021,6 +1021,9 @@ type ILGenericParameterDef = /// Indicates the type argument must have a public nullary constructor. HasDefaultConstructorConstraint: bool + /// Indicates the type parameter allows ref struct, i.e. an anti constraint. + HasAllowsRefStruct: bool + /// Do not use this CustomAttrsStored: ILAttributesStored diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 5dcc051ab9f..94677898f6d 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -2291,6 +2291,7 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numTypars, a, b)) = HasReferenceTypeConstraint = (flags &&& 0x0004) <> 0 HasNotNullableValueTypeConstraint = (flags &&& 0x0008) <> 0 HasDefaultConstructorConstraint = (flags &&& 0x0010) <> 0 + HasAllowsRefStruct = (flags &&& 0x0020) <> 0 }) ) diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index f1112b334f8..832aa1c2810 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -2513,7 +2513,8 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = | ContraVariant -> 0x0002) ||| (if gp.HasReferenceTypeConstraint then 0x0004 else 0x0000) ||| (if gp.HasNotNullableValueTypeConstraint then 0x0008 else 0x0000) ||| - (if gp.HasDefaultConstructorConstraint then 0x0010 else 0x0000) + (if gp.HasDefaultConstructorConstraint then 0x0010 else 0x0000) ||| + (if gp.HasAllowsRefStruct then 0x0020 else 0x0000) let mdVersionMajor, _ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 2b1308dcddc..6758b6dcd94 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2070,6 +2070,7 @@ type AnonTypeGenerationTable() = HasReferenceTypeConstraint = false HasNotNullableValueTypeConstraint = false HasDefaultConstructorConstraint = false + HasAllowsRefStruct = false MetadataIndex = NoMetadataIdx } ] @@ -5733,6 +5734,7 @@ and GenGenericParam cenv eenv (tp: Typar) = HasReferenceTypeConstraint = refTypeConstraint HasNotNullableValueTypeConstraint = notNullableValueTypeConstraint || emitUnmanagedInIlOutput HasDefaultConstructorConstraint = defaultConstructorConstraint + HasAllowsRefStruct = false } //-------------------------------------------------------------------------- diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs index dca7589c903..32be731e7c8 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs @@ -53,4 +53,58 @@ module ``Byref interop verification tests`` = """ |> asExe |> compileAndRun - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + + [] + let ``Ref structs in generics - can declare`` () = + FSharp """module Foo +open System +let x(a:Action>) = () + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let ``Ref structs in generics - can use in object expressions`` () = + FSharp """module Foo +open System + +let main _args = + let comparer = + { new System.IComparable> + with member x.CompareTo(o) = 42 } + comparer.CompareTo(ReadOnlySpan([||])) + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let ``Ref structs in generics - can use in foreach`` () = + FSharp """module Foo +open System + +let processSeq (input:seq>) = + for ros in input do + printfn "%i" (ros.Length) + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let ``Ref structs in generics - GetAlternateLookup`` () = + FSharp """module Foo +open System +open System.Collections.Generic + +let main _args = + let myDict = ["x",1;"y",2] |> dict |> Dictionary + let altLookup = myDict.GetAlternateLookup>() + altLookup.ContainsKey(ReadOnlySpan([|'x'|])) + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + From 9924fcbc651b4e631c8d4801f24331090439a879 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 23 Aug 2024 17:07:03 +0200 Subject: [PATCH 02/13] prototype impl --- src/Compiler/AbstractIL/il.fs | 4 +- src/Compiler/AbstractIL/ilreflect.fs | 43 +++---- src/Compiler/Checking/PostInferenceChecks.fs | 106 +++++++++++++----- .../Interop/ByrefTests.fs | 15 ++- 4 files changed, 116 insertions(+), 52 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index f201b896fc1..9ed1822676b 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1862,10 +1862,10 @@ type ILGenericParameterDef = Name: string Constraints: ILTypes Variance: ILGenericVariance - HasReferenceTypeConstraint: bool - HasAllowsRefStruct: bool + HasReferenceTypeConstraint: bool HasNotNullableValueTypeConstraint: bool HasDefaultConstructorConstraint: bool + HasAllowsRefStruct: bool CustomAttrsStored: ILAttributesStored MetadataIndex: int32 } diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index 8c56aca9be8..9b0b7eddb9e 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -1714,31 +1714,34 @@ let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParamet gp.CustomAttrs |> emitCustomAttrs cenv emEnv (wrapCustomAttr gpB.SetCustomAttribute) - let flags = GenericParameterAttributes.None - let flags = match gp.Variance with - | NonVariant -> flags - | CoVariant -> flags ||| GenericParameterAttributes.Covariant - | ContraVariant -> flags ||| GenericParameterAttributes.Contravariant + | NonVariant -> GenericParameterAttributes.None + | CoVariant -> GenericParameterAttributes.Covariant + | ContraVariant -> GenericParameterAttributes.Contravariant - let flags = - if gp.HasReferenceTypeConstraint then - flags ||| GenericParameterAttributes.ReferenceTypeConstraint - else - flags + let zero = GenericParameterAttributes.None let flags = - if gp.HasNotNullableValueTypeConstraint then - flags ||| GenericParameterAttributes.NotNullableValueTypeConstraint - else - flags - - let flags = - if gp.HasDefaultConstructorConstraint then - flags ||| GenericParameterAttributes.DefaultConstructorConstraint - else - flags + flags + ||| (if gp.HasReferenceTypeConstraint then + GenericParameterAttributes.ReferenceTypeConstraint + else + zero) + ||| (if gp.HasNotNullableValueTypeConstraint then + GenericParameterAttributes.NotNullableValueTypeConstraint + else + zero) + ||| (if gp.HasDefaultConstructorConstraint then + GenericParameterAttributes.DefaultConstructorConstraint + else + zero) + ||| + // GenericParameterAttributes.AllowByRefLike from net9, not present in ns20 + (if gp.HasAllowsRefStruct then + (enum 0x0020) + else + zero) gpB.SetGenericParameterAttributes flags) //---------------------------------------------------------------------------- diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 3fbe6427248..81477607c20 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -28,6 +28,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations +open Import //-------------------------------------------------------------------------- // NOTES: reraise safety checks @@ -334,7 +335,15 @@ let RecordAnonRecdInfo cenv (anonInfo: AnonRecdTypeInfo) = // approx walk of type //-------------------------------------------------------------------------- -let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, visitTraitSolutionOpt, visitTyparOpt as f) (g: TcGlobals) env isInner ty = +/// Represents the container for nester type instantions, carrying information about the parent (generic type) and data about correspinding generic typar definition. +/// For current use, IlGenericParameterDef was enough. For other future use cases, conversion into F# Typar might be needed. +type TypeInstCtx = + | NoInfo + | IlGenericInst of parent:TyconRef * genericArg:ILGenericParameterDef + | TyparInst of parent:TyconRef + | TopLevelAllowingByRef + +let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, visitTraitSolutionOpt, visitTyparOpt as f) (g: TcGlobals) env (typeInstParentOpt:TypeInstCtx) ty = // We iterate the _solved_ constraints as well, to pick up any record of trait constraint solutions // This means we walk _all_ the constraints _everywhere_ in a type, including // those attached to _solved_ type variables. This is used by PostTypeCheckSemanticChecks to detect uses of @@ -366,22 +375,30 @@ let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, vi match ty with | TType_forall (tps, body) -> let env = BindTypars g env tps - CheckTypeDeep cenv f g env isInner body + CheckTypeDeep cenv f g env typeInstParentOpt body tps |> List.iter (fun tp -> tp.Constraints |> List.iter (CheckTypeConstraintDeep cenv f g env)) | TType_measure _ -> () | TType_app (tcref, tinst, _) -> match visitTyconRefOpt with - | Some visitTyconRef -> visitTyconRef isInner tcref + | Some visitTyconRef -> visitTyconRef typeInstParentOpt tcref | None -> () // If it's a 'byref<'T>', don't check 'T as an inner. This allows byref>. // 'byref>' is invalid and gets checked in visitAppTy. - if isByrefTyconRef g tcref then - CheckTypesDeepNoInner cenv f g env tinst + //if isByrefTyconRef g tcref then + // CheckTypesDeepNoInner cenv f g env tinst + + if tcref.IsILTycon && tinst.Length = tcref.ILTyconRawMetadata.GenericParams.Length then + (tinst,tcref.ILTyconRawMetadata.GenericParams) + ||> List.iter2 (fun ty ilGenericParam -> + let typeInstParent = IlGenericInst(tcref, ilGenericParam) + CheckTypeDeep cenv f g env typeInstParent ty) else - CheckTypesDeep cenv f g env tinst + let parentRef = TyparInst(tcref) + for ty in tinst do + CheckTypeDeep cenv f g env parentRef ty match visitAppTyOpt with | Some visitAppTy -> visitAppTy (tcref, tinst) @@ -398,8 +415,8 @@ let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, vi CheckTypesDeep cenv f g env tys | TType_fun (s, t, _) -> - CheckTypeDeep cenv f g env true s - CheckTypeDeep cenv f g env true t + CheckTypeDeep cenv f g env NoInfo s + CheckTypeDeep cenv f g env NoInfo t | TType_var (tp, _) -> if not tp.IsSolved then @@ -410,20 +427,16 @@ let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, vi and CheckTypesDeep cenv f g env tys = for ty in tys do - CheckTypeDeep cenv f g env true ty - -and CheckTypesDeepNoInner cenv f g env tys = - for ty in tys do - CheckTypeDeep cenv f g env false ty + CheckTypeDeep cenv f g env NoInfo ty and CheckTypeConstraintDeep cenv f g env x = match x with - | TyparConstraint.CoercesTo(ty, _) -> CheckTypeDeep cenv f g env true ty + | TyparConstraint.CoercesTo(ty, _) -> CheckTypeDeep cenv f g env NoInfo ty | TyparConstraint.MayResolveMember(traitInfo, _) -> CheckTraitInfoDeep cenv f g env traitInfo - | TyparConstraint.DefaultsTo(_, ty, _) -> CheckTypeDeep cenv f g env true ty + | TyparConstraint.DefaultsTo(_, ty, _) -> CheckTypeDeep cenv f g env NoInfo ty | TyparConstraint.SimpleChoice(tys, _) -> CheckTypesDeep cenv f g env tys - | TyparConstraint.IsEnum(underlyingTy, _) -> CheckTypeDeep cenv f g env true underlyingTy - | TyparConstraint.IsDelegate(argTys, retTy, _) -> CheckTypeDeep cenv f g env true argTys; CheckTypeDeep cenv f g env true retTy + | TyparConstraint.IsEnum(underlyingTy, _) -> CheckTypeDeep cenv f g env NoInfo underlyingTy + | TyparConstraint.IsDelegate(argTys, retTy, _) -> CheckTypeDeep cenv f g env NoInfo argTys; CheckTypeDeep cenv f g env NoInfo retTy | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -436,18 +449,18 @@ and CheckTypeConstraintDeep cenv f g env x = and CheckTraitInfoDeep cenv (_, _, _, visitTraitSolutionOpt, _ as f) g env traitInfo = CheckTypesDeep cenv f g env traitInfo.SupportTypes CheckTypesDeep cenv f g env traitInfo.CompiledObjectAndArgumentTypes - Option.iter (CheckTypeDeep cenv f g env true ) traitInfo.CompiledReturnType + Option.iter (CheckTypeDeep cenv f g env NoInfo ) traitInfo.CompiledReturnType match visitTraitSolutionOpt, traitInfo.Solution with | Some visitTraitSolution, Some sln -> visitTraitSolution sln | _ -> () /// Check for byref-like types let CheckForByrefLikeType cenv env m ty check = - CheckTypeDeep cenv (ignore, Some (fun _deep tcref -> if isByrefLikeTyconRef cenv.g m tcref then check()), None, None, None) cenv.g env false ty + CheckTypeDeep cenv (ignore, Some (fun _typeInstParent tcref -> if isByrefLikeTyconRef cenv.g m tcref then check()), None, None, None) cenv.g env NoInfo ty /// Check for byref types let CheckForByrefType cenv env ty check = - CheckTypeDeep cenv (ignore, Some (fun _deep tcref -> if isByrefTyconRef cenv.g tcref then check()), None, None, None) cenv.g env false ty + CheckTypeDeep cenv (ignore, Some (fun _typeInstParent tcref -> if isByrefTyconRef cenv.g tcref then check()), None, None, None) cenv.g env NoInfo ty /// check captures under lambdas /// @@ -516,7 +529,7 @@ let CheckTypeForAccess (cenv: cenv) env objName valAcc m ty = if isLessAccessible tyconAcc valAcc then errorR(Error(FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())), m)) - CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env false ty + CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty = if cenv.reportErrors then @@ -534,7 +547,7 @@ let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty = let warningText = errorText + Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime() warning(AttributeChecking.ObsoleteWarning(warningText, m)) - CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env false ty + CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty /// Indicates whether a byref or byref-like type is permitted at a particular location [] @@ -629,16 +642,27 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = else errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(tp.DisplayName), m)) - let visitTyconRef isInner tcref = + let visitTyconRef (ctx:TypeInstCtx) tcref = + let checkInner() = + match ctx with + | TopLevelAllowingByRef -> false + | TyparInst(parentTcRef) + | IlGenericInst(parentTcRef,_) when isByrefTyconRef cenv.g parentTcRef -> false + | _ -> true + + let isInnerByRefLike() = checkInner() && isByrefLikeTyconRef cenv.g m tcref - let isInnerByRefLike = isInner && isByrefLikeTyconRef cenv.g m tcref + let permitByRefLike = + match ctx with + | IlGenericInst(_,ilTypar) when ilTypar.HasAllowsRefStruct -> PermitByRefType.All + | _ -> permitByRefLike match permitByRefLike with | PermitByRefType.None when isByrefLikeTyconRef cenv.g m tcref -> errorR(Error(FSComp.SR.chkErrorUseOfByref(), m)) - | PermitByRefType.NoInnerByRefLike when isInnerByRefLike -> + | PermitByRefType.NoInnerByRefLike when isInnerByRefLike() -> onInnerByrefError () - | PermitByRefType.SpanLike when isByrefTyconRef cenv.g tcref || isInnerByRefLike -> + | PermitByRefType.SpanLike when isByrefTyconRef cenv.g tcref || isInnerByRefLike() -> onInnerByrefError () | _ -> () @@ -665,7 +689,9 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = cenv.potentialUnboundUsesOfVals <- cenv.potentialUnboundUsesOfVals.Add(vref.Stamp, m) | _ -> () - CheckTypeDeep cenv (ignore, Some visitTyconRef, Some visitAppTy, Some visitTraitSolution, Some visitTyar) cenv.g env false ty + let initialCtx = if permitByRefLike = PermitByRefType.NoInnerByRefLike then TopLevelAllowingByRef else NoInfo + + CheckTypeDeep cenv (ignore, Some visitTyconRef, Some visitAppTy, Some visitTraitSolution, Some visitTyar) cenv.g env initialCtx ty let CheckType permitByRefLike cenv env m ty = CheckTypeAux permitByRefLike cenv env m ty (fun () -> errorR(Error(FSComp.SR.chkErrorUseOfByref(), m))) @@ -1458,9 +1484,31 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr = CombineTwoLimits limit1 limit2 | TOp.ILCall (_, _, _, _, _, _, _, ilMethRef, enclTypeInst, methInst, retTypes), _, _ -> + CheckTypeInstNoByrefs cenv env m tyargs - CheckTypeInstNoByrefs cenv env m enclTypeInst - CheckTypeInstNoByrefs cenv env m methInst + + match enclTypeInst,methInst with + | [],[] -> () + | enclTypeInst,methInst -> + let tyconRef = ImportILTypeRef cenv.amap m ilMethRef.DeclaringTypeRef + (enclTypeInst,tyconRef.ILTyconRawMetadata.GenericParams) + ||> List.iter2 (fun typeInst typeGeneric -> + if not typeGeneric.HasAllowsRefStruct then + CheckTypeNoByrefs cenv env m typeInst) + + match methInst with + | [] -> () + | methInst -> + let methDef = + match tyconRef.ILTyconInfo with + | TILObjectReprData(scoref, _, tdef) -> + resolveILMethodRefWithRescope (rescopeILType scoref) tdef ilMethRef + + (methInst,methDef.GenericParams) + ||> List.iter2 (fun methInst methGeneric -> + if not methGeneric.HasAllowsRefStruct then + CheckTypeNoByrefs cenv env m methInst) + CheckTypeInstNoInnerByrefs cenv env m retTypes // permit byref returns let hasReceiver = diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs index 32be731e7c8..27fba06f018 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs @@ -59,7 +59,20 @@ module ``Byref interop verification tests`` = let ``Ref structs in generics - can declare`` () = FSharp """module Foo open System -let x(a:Action>) = () +let x(a:Action>) = a.Invoke(ReadOnlySpan([||])) + """ + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + let ``Ref structs in generics - can return as inner`` () = + + FSharp """module Foo +open System +let x() = + let a:(Action>) = fun _ -> () + a """ |> withLangVersionPreview |> typecheck From 4b57005426af8178c36603490982b55fbf5b81d7 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 23 Aug 2024 21:11:44 +0200 Subject: [PATCH 03/13] Get stacktrace for error (to be REMOVED!) --- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index af19ae2f617..67794424295 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -412,6 +412,8 @@ type internal DiagnosticsThreadStatics = [] module DiagnosticsLoggerExtensions = + let PutStackTraceToErrors = (Environment.GetEnvironmentVariable("FSC_PutStackTrace_To_Errors") = "1") || true + // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV // This uses a simple heuristic to detect it (the vsversion is < 16.0) let tryAndDetectDev15 = @@ -454,6 +456,8 @@ module DiagnosticsLoggerExtensions = member x.ErrorR exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error) + if PutStackTraceToErrors then + eprintfn "Stack trace for %s: %s" (exn.GetType().Name) (exn.StackTrace) member x.Warning exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Warning) From 72fc4803a63bc320bbd59ab74e437fe793e732f5 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 23 Aug 2024 22:03:55 +0200 Subject: [PATCH 04/13] write more logs --- src/Compiler/Facilities/DiagnosticsLogger.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 67794424295..275cf5bf07e 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -457,7 +457,10 @@ module DiagnosticsLoggerExtensions = member x.ErrorR exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error) if PutStackTraceToErrors then - eprintfn "Stack trace for %s: %s" (exn.GetType().Name) (exn.StackTrace) + let msg = sprintf "Stack trace for %s: %s" (exn.GetType().Name) (exn.StackTrace) + eprintfn "eprintfn %s" msg + printfn "printfn %s" msg + x.EmitDiagnostic(InternalError(msg, range0), FSharpDiagnosticSeverity.Error) member x.Warning exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Warning) From f047c3cb6b004b2fb6e7fe045f46e78de728e67c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 23 Aug 2024 22:17:57 +0200 Subject: [PATCH 05/13] Environment.StackTrace --- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 275cf5bf07e..9c2eab31933 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -457,7 +457,7 @@ module DiagnosticsLoggerExtensions = member x.ErrorR exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error) if PutStackTraceToErrors then - let msg = sprintf "Stack trace for %s: %s" (exn.GetType().Name) (exn.StackTrace) + let msg = sprintf "Stack trace for %s: %s" (exn.GetType().Name) (System.Environment.StackTrace) eprintfn "eprintfn %s" msg printfn "printfn %s" msg x.EmitDiagnostic(InternalError(msg, range0), FSharpDiagnosticSeverity.Error) From aee61db768acefb4d1c449eab9f27b8ec1d68e01 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 23 Aug 2024 22:38:22 +0200 Subject: [PATCH 06/13] Check if CanDeref (was failing for unit type) --- src/Compiler/Checking/PostInferenceChecks.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 81477607c20..e14d14ba077 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -390,7 +390,7 @@ let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, vi //if isByrefTyconRef g tcref then // CheckTypesDeepNoInner cenv f g env tinst - if tcref.IsILTycon && tinst.Length = tcref.ILTyconRawMetadata.GenericParams.Length then + if tcref.CanDeref && tcref.IsILTycon && tinst.Length = tcref.ILTyconRawMetadata.GenericParams.Length then (tinst,tcref.ILTyconRawMetadata.GenericParams) ||> List.iter2 (fun ty ilGenericParam -> let typeInstParent = IlGenericInst(tcref, ilGenericParam) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 9c2eab31933..c0b32169af1 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -412,7 +412,7 @@ type internal DiagnosticsThreadStatics = [] module DiagnosticsLoggerExtensions = - let PutStackTraceToErrors = (Environment.GetEnvironmentVariable("FSC_PutStackTrace_To_Errors") = "1") || true + let PutStackTraceToErrors = (Environment.GetEnvironmentVariable("FSC_PutStackTrace_To_Errors") = "1") || false // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV // This uses a simple heuristic to detect it (the vsversion is < 16.0) @@ -458,8 +458,6 @@ module DiagnosticsLoggerExtensions = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error) if PutStackTraceToErrors then let msg = sprintf "Stack trace for %s: %s" (exn.GetType().Name) (System.Environment.StackTrace) - eprintfn "eprintfn %s" msg - printfn "printfn %s" msg x.EmitDiagnostic(InternalError(msg, range0), FSharpDiagnosticSeverity.Error) member x.Warning exn = From d087f39a14f6c41bc746e6134b2c13cf70e0f771 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Aug 2024 12:22:54 +0200 Subject: [PATCH 07/13] Adjust for spanlikes and custom byreflikes --- src/Compiler/Checking/PostInferenceChecks.fs | 6 +- .../Interop/ByrefTests.fs | 63 ++++++++++++++++++- 2 files changed, 67 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index e14d14ba077..4f4bcbf667b 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -689,7 +689,11 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = cenv.potentialUnboundUsesOfVals <- cenv.potentialUnboundUsesOfVals.Add(vref.Stamp, m) | _ -> () - let initialCtx = if permitByRefLike = PermitByRefType.NoInnerByRefLike then TopLevelAllowingByRef else NoInfo + let initialCtx = + match permitByRefLike with + | PermitByRefType.SpanLike + | PermitByRefType.NoInnerByRefLike -> TopLevelAllowingByRef + | _ -> NoInfo CheckTypeDeep cenv (ignore, Some visitTyconRef, Some visitAppTy, Some visitTraitSolution, Some visitTyar) cenv.g env initialCtx ty diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs index 27fba06f018..fe66abe1149 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs @@ -71,7 +71,7 @@ let x(a:Action>) = a.Invoke(ReadOnlySpan([||])) FSharp """module Foo open System let x() = - let a:(Action>) = fun _ -> () + let a:(Action>) = Unchecked.defaultof<_> a """ |> withLangVersionPreview @@ -106,6 +106,36 @@ let processSeq (input:seq>) = |> typecheck |> shouldSucceed + [] + let ``Ref structs in generics - IL and runtime test`` () = + FSharp """module Foo +open System +open System.Collections.Generic + +let myDict = ["x",1;"xyz",2] |> dict |> Dictionary + +let checkIfPresent (input:ReadOnlySpan) = + let altLookup = myDict.GetAlternateLookup>() + let present = altLookup.ContainsKey(input) + for c in input do + printf "%c" c + printfn ": %A" present + +[] +let main _args = + checkIfPresent(ReadOnlySpan([||])) + checkIfPresent("x".AsSpan()) + checkIfPresent(ReadOnlySpan([|'x';'y';'z'|])) + 0 + """ + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed + |> verifyOutputContains [|": false";"x: true";"xyz: true"|] + |> verifyIL + ["call valuetype [System.Collections]System.Collections.Generic.Dictionary`2/AlternateLookup`1 [System.Collections]System.Collections.Generic.CollectionExtensions::GetAlternateLookup>(class [System.Collections]System.Collections.Generic.Dictionary`2)"] + [] let ``Ref structs in generics - GetAlternateLookup`` () = FSharp """module Foo @@ -121,3 +151,34 @@ let main _args = |> typecheck |> shouldSucceed + [] + let ``Ref structs in generics - negative tests`` () = + FSharp """module Foo +open System +open System.Collections.Generic + +[] +type MyRecordFullOfWrongStuff<'T> = + { Value : Span<'T> + MyMap : list> + MyDict: Dictionary> + Nested: Span> } + +let processRecord (recd:MyRecordFullOfWrongStuff>>) = + recd.MyDict.["x"] + + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics + [ Error 412, Line 7, Col 7, Line 7, Col 12, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + Error 437, Line 6, Col 6, Line 6, Col 30, "A type would store a byref typed value. This is not permitted by Common IL." + Error 412, Line 8, Col 7, Line 8, Col 12, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + Error 412, Line 9, Col 7, Line 9, Col 13, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + Error 412, Line 10, Col 7, Line 10, Col 13, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + Error 3300, Line 12, Col 20, Line 12, Col 24, "The parameter 'recd' has an invalid type 'MyRecordFullOfWrongStuff>>'. This is not permitted by the rules of Common IL." + Error 412, Line 13, Col 5, Line 13, Col 22, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + Error 412, Line 13, Col 5, Line 13, Col 16, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + Error 412, Line 13, Col 5, Line 13, Col 9, "A type instantiation involves a byref type. This is not permitted by the rules of Common IL."] + From a6e49ac43ee63c16ed795790b6a4ef19be2fcafa Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Aug 2024 12:30:09 +0200 Subject: [PATCH 08/13] tests with custom IsByRefLikeAttribute --- tests/fsharp/Compiler/Language/SpanTests.fs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/fsharp/Compiler/Language/SpanTests.fs b/tests/fsharp/Compiler/Language/SpanTests.fs index aef001deec2..d02cca4e8f5 100644 --- a/tests/fsharp/Compiler/Language/SpanTests.fs +++ b/tests/fsharp/Compiler/Language/SpanTests.fs @@ -175,4 +175,22 @@ type IsByRefLikeAttribute() = inherit Attribute() type T(span: Span) = struct end """ [| |] + + [] + let ``A byref struct with custom attr can be passed as typar``() = + CompilerAssert.TypeCheckWithErrors """ +namespace System.Runtime.CompilerServices + +open System + +[] +type IsByRefLikeAttribute() = inherit Attribute() + +[] +type T(span: Span) = struct end + +module WhatEver = + let processT (a: Action, ie: seq, asList: list) = () + """ + [| FSharpDiagnosticSeverity.Error, 3300, (13, 45, 13, 51), "The parameter 'asList' has an invalid type 'T list'. This is not permitted by the rules of Common IL." |] #endif \ No newline at end of file From de368483c15bf4e0e7845ff2dd753ced6d1875e6 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Aug 2024 12:38:55 +0200 Subject: [PATCH 09/13] fantomas --- src/Compiler/Facilities/DiagnosticsLogger.fs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index c0b32169af1..1c59ee76945 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -412,7 +412,9 @@ type internal DiagnosticsThreadStatics = [] module DiagnosticsLoggerExtensions = - let PutStackTraceToErrors = (Environment.GetEnvironmentVariable("FSC_PutStackTrace_To_Errors") = "1") || false + let PutStackTraceToErrors = + (Environment.GetEnvironmentVariable("FSC_PutStackTrace_To_Errors") = "1") + || false // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV // This uses a simple heuristic to detect it (the vsversion is < 16.0) @@ -456,8 +458,11 @@ module DiagnosticsLoggerExtensions = member x.ErrorR exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error) + if PutStackTraceToErrors then - let msg = sprintf "Stack trace for %s: %s" (exn.GetType().Name) (System.Environment.StackTrace) + let msg = + sprintf "Stack trace for %s: %s" (exn.GetType().Name) (System.Environment.StackTrace) + x.EmitDiagnostic(InternalError(msg, range0), FSharpDiagnosticSeverity.Error) member x.Warning exn = From ebb3a3cc0440ac6f150f92cdd2eef4e481de5374 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Aug 2024 15:18:22 +0200 Subject: [PATCH 10/13] fix typeprovider scenario --- src/Compiler/Checking/PostInferenceChecks.fs | 34 +++++++++---------- ...ervice.SurfaceArea.netstandard20.debug.bsl | 4 ++- ...vice.SurfaceArea.netstandard20.release.bsl | 4 ++- 3 files changed, 23 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 4f4bcbf667b..3af12e0c165 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -1495,23 +1495,23 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr = | [],[] -> () | enclTypeInst,methInst -> let tyconRef = ImportILTypeRef cenv.amap m ilMethRef.DeclaringTypeRef - (enclTypeInst,tyconRef.ILTyconRawMetadata.GenericParams) - ||> List.iter2 (fun typeInst typeGeneric -> - if not typeGeneric.HasAllowsRefStruct then - CheckTypeNoByrefs cenv env m typeInst) - - match methInst with - | [] -> () - | methInst -> - let methDef = - match tyconRef.ILTyconInfo with - | TILObjectReprData(scoref, _, tdef) -> - resolveILMethodRefWithRescope (rescopeILType scoref) tdef ilMethRef - - (methInst,methDef.GenericParams) - ||> List.iter2 (fun methInst methGeneric -> - if not methGeneric.HasAllowsRefStruct then - CheckTypeNoByrefs cenv env m methInst) + match tyconRef.TypeReprInfo with + | TILObjectRepr(TILObjectReprData(scoref, _, tdef)) -> + (enclTypeInst,tdef.GenericParams) + ||> List.iter2 (fun typeInst typeGeneric -> + if not typeGeneric.HasAllowsRefStruct then + CheckTypeNoByrefs cenv env m typeInst) + + match methInst with + | [] -> () + | methInst -> + let methDef = resolveILMethodRefWithRescope (rescopeILType scoref) tdef ilMethRef + (methInst,methDef.GenericParams) + ||> List.iter2 (fun methInst methGeneric -> + if not methGeneric.HasAllowsRefStruct then + CheckTypeNoByrefs cenv env m methInst) + + | _ -> () CheckTypeInstNoInnerByrefs cenv env m retTypes // permit byref returns diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 820f94aa28a..47a8e6166fb 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -670,9 +670,11 @@ FSharp.Compiler.AbstractIL.IL+ILFieldSpec: System.String Name FSharp.Compiler.AbstractIL.IL+ILFieldSpec: System.String ToString() FSharp.Compiler.AbstractIL.IL+ILFieldSpec: System.String get_Name() FSharp.Compiler.AbstractIL.IL+ILFieldSpec: Void .ctor(ILFieldRef, ILType) +FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasAllowsRefStruct FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasDefaultConstructorConstraint FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasNotNullableValueTypeConstraint FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasReferenceTypeConstraint +FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasAllowsRefStruct() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasDefaultConstructorConstraint() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasNotNullableValueTypeConstraint() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasReferenceTypeConstraint() @@ -689,7 +691,7 @@ FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Microsoft.FSharp.Collection FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: System.String Name FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: System.String ToString() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: System.String get_Name() -FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Void .ctor(System.String, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILType], ILGenericVariance, Boolean, Boolean, Boolean, ILAttributesStored, Int32) +FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Void .ctor(System.String, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILType], ILGenericVariance, Boolean, Boolean, Boolean, Boolean, ILAttributesStored, Int32) FSharp.Compiler.AbstractIL.IL+ILGenericVariance+Tags: Int32 CoVariant FSharp.Compiler.AbstractIL.IL+ILGenericVariance+Tags: Int32 ContraVariant FSharp.Compiler.AbstractIL.IL+ILGenericVariance+Tags: Int32 NonVariant diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 820f94aa28a..47a8e6166fb 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -670,9 +670,11 @@ FSharp.Compiler.AbstractIL.IL+ILFieldSpec: System.String Name FSharp.Compiler.AbstractIL.IL+ILFieldSpec: System.String ToString() FSharp.Compiler.AbstractIL.IL+ILFieldSpec: System.String get_Name() FSharp.Compiler.AbstractIL.IL+ILFieldSpec: Void .ctor(ILFieldRef, ILType) +FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasAllowsRefStruct FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasDefaultConstructorConstraint FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasNotNullableValueTypeConstraint FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean HasReferenceTypeConstraint +FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasAllowsRefStruct() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasDefaultConstructorConstraint() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasNotNullableValueTypeConstraint() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Boolean get_HasReferenceTypeConstraint() @@ -689,7 +691,7 @@ FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Microsoft.FSharp.Collection FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: System.String Name FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: System.String ToString() FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: System.String get_Name() -FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Void .ctor(System.String, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILType], ILGenericVariance, Boolean, Boolean, Boolean, ILAttributesStored, Int32) +FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef: Void .ctor(System.String, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILType], ILGenericVariance, Boolean, Boolean, Boolean, Boolean, ILAttributesStored, Int32) FSharp.Compiler.AbstractIL.IL+ILGenericVariance+Tags: Int32 CoVariant FSharp.Compiler.AbstractIL.IL+ILGenericVariance+Tags: Int32 ContraVariant FSharp.Compiler.AbstractIL.IL+ILGenericVariance+Tags: Int32 NonVariant From 6472e28ae53cb200fda4230a12a5025edddd5c58 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Aug 2024 15:30:16 +0200 Subject: [PATCH 11/13] release notes --- docs/release-notes/.FSharp.Compiler.Service/9.0.100.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md index d3e795bf8b7..1d38ddec633 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md @@ -24,6 +24,7 @@ * Allow object expression without overrides. ([Language suggestion #632](https://github.com/fsharp/fslang-suggestions/issues/632), [PR #17387](https://github.com/dotnet/fsharp/pull/17387)) * Enable FSharp 9.0 Language Version ([Issue #17497](https://github.com/dotnet/fsharp/issues/17438)), [PR](https://github.com/dotnet/fsharp/pull/17500))) * Enable LanguageFeature.EnforceAttributeTargets in F# 9.0. ([Issue #17514](https://github.com/dotnet/fsharp/issues/17558), [PR #17516](https://github.com/dotnet/fsharp/pull/17558)) +* Enable consuming generic arguments defined as `allows ref struct` in C# ([Issue #17597](https://github.com/dotnet/fsharp/issues/17597) ### Changed From 6c5a760e5705c3d567bc5cf0a68b6b1a2fca86ab Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 30 Aug 2024 16:43:03 +0200 Subject: [PATCH 12/13] ref structs in CEs (normal as well as resumable) --- src/Compiler/Checking/PostInferenceChecks.fs | 14 ++++--- .../Interop/ByrefTests.fs | 37 +++++++++++++++++++ 2 files changed, 46 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 3af12e0c165..06ef1b9766a 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -343,6 +343,11 @@ type TypeInstCtx = | TyparInst of parent:TyconRef | TopLevelAllowingByRef + with member x.TyparAllowsRefStruct() = + match x with + | IlGenericInst(_,ilTypar) -> ilTypar.HasAllowsRefStruct + | _ -> false + let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, visitTraitSolutionOpt, visitTyparOpt as f) (g: TcGlobals) env (typeInstParentOpt:TypeInstCtx) ty = // We iterate the _solved_ constraints as well, to pick up any record of trait constraint solutions // This means we walk _all_ the constraints _everywhere_ in a type, including @@ -456,11 +461,11 @@ and CheckTraitInfoDeep cenv (_, _, _, visitTraitSolutionOpt, _ as f) g env trait /// Check for byref-like types let CheckForByrefLikeType cenv env m ty check = - CheckTypeDeep cenv (ignore, Some (fun _typeInstParent tcref -> if isByrefLikeTyconRef cenv.g m tcref then check()), None, None, None) cenv.g env NoInfo ty + CheckTypeDeep cenv (ignore, Some (fun ctx tcref -> if (isByrefLikeTyconRef cenv.g m tcref && not(ctx.TyparAllowsRefStruct())) then check()), None, None, None) cenv.g env NoInfo ty /// Check for byref types let CheckForByrefType cenv env ty check = - CheckTypeDeep cenv (ignore, Some (fun _typeInstParent tcref -> if isByrefTyconRef cenv.g tcref then check()), None, None, None) cenv.g env NoInfo ty + CheckTypeDeep cenv (ignore, Some (fun _ctx tcref -> if isByrefTyconRef cenv.g tcref then check()), None, None, None) cenv.g env NoInfo ty /// check captures under lambdas /// @@ -653,9 +658,8 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = let isInnerByRefLike() = checkInner() && isByrefLikeTyconRef cenv.g m tcref let permitByRefLike = - match ctx with - | IlGenericInst(_,ilTypar) when ilTypar.HasAllowsRefStruct -> PermitByRefType.All - | _ -> permitByRefLike + if ctx.TyparAllowsRefStruct() then PermitByRefType.All else permitByRefLike + match permitByRefLike with | PermitByRefType.None when isByrefLikeTyconRef cenv.g m tcref -> diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs index fe66abe1149..db89445122b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs @@ -151,6 +151,43 @@ let main _args = |> typecheck |> shouldSucceed + [] + [ Async.RunSynchronously")>] + [] + let ``Ref structs in generics - builders`` (build:string) (getter:string) = + + FSharp $$$"""module Foo +open System + +let getAction() = + {{{build}}} { + let x = new Action>(fun ros -> printfn "%i" ros.Length) + return x + } + +let getBuilderResult() = + {{{build}}} { + let! myAction = getAction() + myAction.Invoke(ReadOnlySpan([|1|])) + return myAction + } + +[] +let main _args = + let myTask = getBuilderResult(){{{getter}}} + printfn "%O" myTask + 0 + """ + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed + |> verifyOutputContains [|"1";"System.Action`1[System.ReadOnlySpan`1[System.Int32]]"|] + |> verifyIL + [ if build = "task" then + "valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1>>>" + else "[FSharp.Core]Microsoft.FSharp.Control.FSharpAsync`1>>>" ] + [] let ``Ref structs in generics - negative tests`` () = FSharp """module Foo From e10afdbdcfa3666b87fa43f6bb9884bacc59992e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 3 Sep 2024 10:38:18 +0200 Subject: [PATCH 13/13] remove testing leftovers --- src/Compiler/Facilities/DiagnosticsLogger.fs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 1c59ee76945..af19ae2f617 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -412,10 +412,6 @@ type internal DiagnosticsThreadStatics = [] module DiagnosticsLoggerExtensions = - let PutStackTraceToErrors = - (Environment.GetEnvironmentVariable("FSC_PutStackTrace_To_Errors") = "1") - || false - // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV // This uses a simple heuristic to detect it (the vsversion is < 16.0) let tryAndDetectDev15 = @@ -459,12 +455,6 @@ module DiagnosticsLoggerExtensions = member x.ErrorR exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error) - if PutStackTraceToErrors then - let msg = - sprintf "Stack trace for %s: %s" (exn.GetType().Name) (System.Environment.StackTrace) - - x.EmitDiagnostic(InternalError(msg, range0), FSharpDiagnosticSeverity.Error) - member x.Warning exn = x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Warning)