diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md index 4029c80e146..59ac02ab855 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md @@ -29,6 +29,7 @@ * Adding warning when consuming generic method returning T|null for types not supporting nullness (structs,anons,tuples) ([PR #18057](https://github.com/dotnet/fsharp/pull/18057)) * Sink: report SynPat.ArrayOrList type ([PR #18127](https://github.com/dotnet/fsharp/pull/18127)) * Show the default value of compiler options ([PR #18054](https://github.com/dotnet/fsharp/pull/18054)) +* Support ValueOption + Struct attribute as optional parameter for methods ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) ### Changed @@ -49,3 +50,5 @@ * Make ILTypeDef base type calculation lazy. ([PR #18005](https://github.com/dotnet/fsharp/pull/18005)) ### Breaking Changes + +* Aliasing `StructAttribute` will now produce a warning (part of [Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) \ No newline at end of file diff --git a/docs/release-notes/.FSharp.Core/9.0.200.md b/docs/release-notes/.FSharp.Core/9.0.200.md index fdcc65f5537..9ee215274b5 100644 --- a/docs/release-notes/.FSharp.Core/9.0.200.md +++ b/docs/release-notes/.FSharp.Core/9.0.200.md @@ -6,8 +6,9 @@ ### Added ### Changed + * String function changed to guarantee a non-null string return type ([PR #17809](https://github.com/dotnet/fsharp/pull/17809)) +* Add Parameters as valid target for the Struct attribute ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) ### Breaking Changes - diff --git a/docs/release-notes/.Language/preview.md b/docs/release-notes/.Language/preview.md index 0d882e20bbe..d6ef41c3d57 100644 --- a/docs/release-notes/.Language/preview.md +++ b/docs/release-notes/.Language/preview.md @@ -3,8 +3,10 @@ * Better generic unmanaged structs handling. ([Language suggestion #692](https://github.com/fsharp/fslang-suggestions/issues/692), [PR #12154](https://github.com/dotnet/fsharp/pull/12154)) * Deprecate places where `seq` can be omitted. ([Language suggestion #1033](https://github.com/fsharp/fslang-suggestions/issues/1033), [PR #17772](https://github.com/dotnet/fsharp/pull/17772)) * Added type conversions cache, only enabled for compiler runs ([PR#17668](https://github.com/dotnet/fsharp/pull/17668)) +* Support ValueOption + Struct attribute as optional parameter for methods ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098)) ### Fixed + * Warn on uppercase identifiers in patterns. ([PR #15816](https://github.com/dotnet/fsharp/pull/15816)) ### Changed diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 80c1a656c2d..bec5c9d9966 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3222,34 +3222,40 @@ module EstablishTypeDefinitionCores = ignore inSig #endif - // This case deals with ordinary type and measure abbreviations - if not hasMeasureableAttr then + // This case deals with ordinary type and measure abbreviations + if not hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurrence.UseInType WarnOnIWSAM.No envinner tpenv rhsType - // Give a warning if `AutoOpenAttribute` is being aliased. + + // Give a warning if `AutoOpenAttribute` or `StructAttribute` is being aliased. // If the user were to alias the `Microsoft.FSharp.Core.AutoOpenAttribute` type, it would not be detected by the project graph dependency resolution algorithm. - match stripTyEqns g ty with - | AppTy g (tcref, _) when not tcref.IsErased -> - match tcref.CompiledRepresentation with - | CompiledTypeRepr.ILAsmOpen _ -> () - | CompiledTypeRepr.ILAsmNamed _ -> - if tcref.CompiledRepresentationForNamedType.FullName = g.attrib_AutoOpenAttribute.TypeRef.FullName then - warning(Error(FSComp.SR.chkAutoOpenAttributeInTypeAbbrev(), tycon.Id.idRange)) - | _ -> () - - if not firstPass then - let ftyvs = freeInTypeLeftToRight g false ty + + let inline checkAttributeAliased ty (tycon: Tycon) (attrib: BuiltinAttribInfo) = + match stripTyEqns g ty with + | AppTy g (tcref, _) when not tcref.IsErased -> + match tcref.CompiledRepresentation with + | CompiledTypeRepr.ILAsmOpen _ -> () + | CompiledTypeRepr.ILAsmNamed _ -> + if tcref.CompiledRepresentationForNamedType.FullName = attrib.TypeRef.FullName then + warning(Error(FSComp.SR.chkAttributeAliased(attrib.TypeRef.FullName), tycon.Id.idRange)) + | _ -> () + + checkAttributeAliased ty tycon g.attrib_AutoOpenAttribute + checkAttributeAliased ty tycon g.attrib_StructAttribute + + if not firstPass then + let ftyvs = freeInTypeLeftToRight g false ty let typars = tycon.Typars m - if ftyvs.Length <> typars.Length then + if ftyvs.Length <> typars.Length then errorR(Deprecated(FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType(), tycon.Range)) if firstPass then tycon.SetTypeAbbrev (Some ty) | _ -> () - - with RecoverableException exn -> + + with RecoverableException exn -> errorRecovery exn m // Third phase: check and publish the super types. Run twice, once before constraints are established diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 0c496517fd4..487c66b0c8c 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -58,6 +58,14 @@ let UnifyRefTupleType contextInfo (cenv: cenv) denv m ty ps = AddCxTypeEqualsType contextInfo denv cenv.css m ty (TType_tuple (tupInfoRef, ptys)) ptys +let inline mkOptionalParamTyBasedOnAttribute (g: TcGlobals) tyarg attribs = + if g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) + && findSynAttribute "StructAttribute" attribs + then + mkValueOptionTy g tyarg + else + mkOptionTy g tyarg + let rec TryAdjustHiddenVarNameToCompGenName (cenv: cenv) env (id: Ident) altNameRefCellOpt = match altNameRefCellOpt with | Some ({contents = SynSimplePatAlternativeIdInfo.Undecided altId } as altNameRefCell) -> @@ -75,7 +83,7 @@ let rec TryAdjustHiddenVarNameToCompGenName (cenv: cenv) env (id: Ident) altName | None -> None /// Bind the patterns used in a lambda. Not clear why we don't use TcPat. -and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = +and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p (attribs: SynAttributes) = let g = cenv.g let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv @@ -85,14 +93,17 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = // Check to see if pattern translation decides to use an alternative identifier. match TryAdjustHiddenVarNameToCompGenName cenv env id altNameRefCellOpt with | Some altId -> - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv (SynSimplePat.Id (altId, None, isCompGen, isMemberThis, isOpt, m) ) + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv (SynSimplePat.Id (altId, None, isCompGen, isMemberThis, isOpt, m) ) attribs | None -> if isOpt then if not optionalArgsOK then errorR(Error(FSComp.SR.tcOptionalArgsOnlyOnMembers(), m)) let tyarg = NewInferenceType g - UnifyTypes cenv env m ty (mkOptionTy g tyarg) + + let optionalParamTy = mkOptionalParamTyBasedOnAttribute g tyarg attribs + + UnifyTypes cenv env m ty optionalParamTy let vFlags = TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, isCompGen) let _, names, takenNames = TcPatBindingName cenv env id ty isMemberThis None None vFlags (names, takenNames) @@ -104,20 +115,23 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = match p with // Optional arguments on members - | SynSimplePat.Id(_, _, _, _, true, _) -> UnifyTypes cenv env m ty (mkOptionTy g ctyR) + | SynSimplePat.Id(_, _, _, _, true, _) -> + let optionalParamTy = mkOptionalParamTyBasedOnAttribute g ctyR attribs + + UnifyTypes cenv env m ty optionalParamTy | _ -> UnifyTypes cenv env m ty ctyR let patEnvR = TcPatLinearEnv(tpenv, names, takenNames) - + // Ensure the untyped typar name sticks match cty, ty with | SynType.Var(typar = SynTypar(ident = untypedIdent)), TType_var(typar = typedTp) -> typedTp.SetIdent(untypedIdent) | _ -> () - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnvR p + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnvR p attribs - | SynSimplePat.Attrib (p, _, _) -> - TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv p + | SynSimplePat.Attrib (p, pattribs, _) -> + TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv p pattribs // raise an error if any optional args precede any non-optional args and ValidateOptArgOrder (synSimplePats: SynSimplePats) = @@ -166,12 +180,12 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS [id.idText], patEnvR | SynSimplePats.SimplePats (pats = [synSimplePat]) -> - let v, patEnv = TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv synSimplePat + let v, patEnv = TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv synSimplePat [] [v], patEnv | SynSimplePats.SimplePats (ps, _, m) -> let ptys = UnifyRefTupleType env.eContextInfo cenv env.DisplayEnv m ty ps - let ps', patEnvR = (patEnv, List.zip ptys ps) ||> List.mapFold (fun patEnv (ty, pat) -> TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv pat) + let ps', patEnvR = (patEnv, List.zip ptys ps) ||> List.mapFold (fun patEnv (ty, pat) -> TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv pat []) ps', patEnvR and TcSimplePatsOfUnknownType (cenv: cenv) optionalArgsOK checkConstraints env tpenv (pat: SynPat) = diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 3343f7dbac3..4c561dd7fee 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -328,21 +328,46 @@ let AdjustCalledArgTypeForTypeDirectedConversionsAndAutoQuote (infoReader: InfoR else AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy callerArgTy m +let inline tryDestOptionalTy g ty = + if isOptionTy g ty then + destOptionTy g ty + elif g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g ty then + destValueOptionTy g ty + else + ty + +let inline mkOptionalTy (g: TcGlobals) ty = + if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g ty then + mkValueOptionTy g ty + else + mkOptionTy g ty + +let inline mkOptionalNone (g: TcGlobals) ty calledArgTy mMethExpr = + if g.langVersion.SupportsFeature LanguageFeature.SupportValueOptionsAsOptionalParameters && isValueOptionTy g ty then + mkValueNone g calledArgTy mMethExpr + else + mkNone g calledArgTy mMethExpr + + /// Adjust the called argument type to take into account whether the caller's argument is CSharpMethod(?arg=Some(3)) or CSharpMethod(arg=1) let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableOptionalsKnownTypes (calledArg: CalledArg) calledArgTy (callerArg: CallerArg<_>) = let g = infoReader.g let m = callerArg.Range let callerArgTy = callerArg.CallerArgumentType - if callerArg.IsExplicitOptional then - match calledArg.OptArgInfo with + if callerArg.IsExplicitOptional then + match calledArg.OptArgInfo with // CSharpMethod(?x = arg), optional C#-style argument, may have nullable type - | CallerSide _ -> + | CallerSide _ -> if g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop then - if isNullableTy g calledArgTy then - mkOptionTy g (destNullableTy g calledArgTy), TypeDirectedConversionUsed.No, None - else - mkOptionTy g calledArgTy, TypeDirectedConversionUsed.No, None + + let calledArgTy = + if isNullableTy g calledArgTy then + destNullableTy g calledArgTy + else + calledArgTy + + mkOptionalTy g calledArgTy, TypeDirectedConversionUsed.No, None else calledArgTy, TypeDirectedConversionUsed.No, None @@ -392,11 +417,7 @@ let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableO // FSharpMethod(x = arg), optional F#-style argument, should have option type | CalleeSide -> - let calledArgTy2 = - if isOptionTy g calledArgTy then - destOptionTy g calledArgTy - else - calledArgTy + let calledArgTy2 = tryDestOptionalTy g calledArgTy AdjustCalledArgTypeForTypeDirectedConversionsAndAutoQuote infoReader ad callerArgTy calledArgTy2 calledArg m // F# supports adhoc conversions at some specific points @@ -1476,11 +1497,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C /// can be used with 'CalleeSide' optional arguments let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCallerMemberName (mMethExpr: range) = let calledArgTy = calledArg.CalledArgumentType - let calledNonOptTy = - if isOptionTy g calledArgTy then - destOptionTy g calledArgTy - else - calledArgTy // should be unreachable + let calledNonOptTy = tryDestOptionalTy g calledArgTy match calledArg.CallerInfo, eCallerMemberName with | CallerLineNumber, _ when typeEquiv g calledNonOptTy g.int_ty -> @@ -1494,7 +1511,8 @@ let GetDefaultExpressionForCalleeSideOptionalArg g (calledArg: CalledArg) eCalle let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy) mkSome g calledNonOptTy memberNameExpr mMethExpr | _ -> - mkNone g calledNonOptTy mMethExpr + mkOptionalNone g calledArgTy calledNonOptTy mMethExpr + /// Get the expression that must be inserted on the caller side for an optional arg where /// no caller argument has been provided. @@ -1573,20 +1591,24 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: // AdjustCallerArgExpr later on will deal with any nullable conversion callerArgExpr - | CalleeSide -> - if isOptCallerArg then + | CalleeSide -> + if isOptCallerArg then // FSharpMethod(?x=b) --> FSharpMethod(?x=b) - callerArgExpr - else + callerArgExpr + else // FSharpMethod(x=b) when FSharpMethod(A) --> FSharpMethod(?x=Some(b :> A)) - if isOptionTy g calledArgTy then - let calledNonOptTy = destOptionTy g calledArgTy + if isOptionTy g calledArgTy then + let calledNonOptTy = destOptionTy g calledArgTy let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr mkSome g calledNonOptTy callerArgExpr2 m - else + elif g.langVersion.SupportsFeature(LanguageFeature.SupportValueOptionsAsOptionalParameters) && isValueOptionTy g calledArgTy then + let calledNonOptTy = destValueOptionTy g calledArgTy + let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr + mkValueSome g calledNonOptTy callerArgExpr2 m + else assert false - callerArgExpr // defensive code - this case is unreachable - + callerArgExpr // defensive code - this case is unreachable + let callerArg2 = CallerArg(tyOfExpr g callerArgExpr2, m, isOptCallerArg, callerArgExpr2) { assignedArg with CallerArg=callerArg2 } diff --git a/src/Compiler/Driver/GraphChecking/TrieMapping.fs b/src/Compiler/Driver/GraphChecking/TrieMapping.fs index 95b22637e9a..215f8a2dae6 100644 --- a/src/Compiler/Driver/GraphChecking/TrieMapping.fs +++ b/src/Compiler/Driver/GraphChecking/TrieMapping.fs @@ -5,6 +5,7 @@ open System.Collections.Immutable open System.Text open FSharp.Compiler.IO open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTreeOps [] module private ImmutableHashSet = @@ -15,34 +16,7 @@ module private ImmutableHashSet = /// Create a new HashSet<'T> with zero elements. let empty () = ImmutableHashSet.Empty -let autoOpenShapes = - set - [| - "FSharp.Core.AutoOpenAttribute" - "Core.AutoOpenAttribute" - "AutoOpenAttribute" - "FSharp.Core.AutoOpen" - "Core.AutoOpen" - "AutoOpen" - |] - -/// This isn't bullet proof, we do prompt a warning when the user is aliasing the AutoOpenAttribute. -let isAutoOpenAttribute (attribute: SynAttribute) = - match attribute.ArgExpr with - | SynExpr.Const(constant = SynConst.Unit) - | SynExpr.Const(constant = SynConst.String _) - | SynExpr.Paren(expr = SynExpr.Const(constant = SynConst.String _)) -> - let attributeName = - attribute.TypeName.LongIdent - |> List.map (fun ident -> ident.idText) - |> String.concat "." - - autoOpenShapes.Contains attributeName - | _ -> false - -let isAnyAttributeAutoOpen (attributes: SynAttributes) = - attributes - |> List.exists (fun (atl: SynAttributeList) -> List.exists isAutoOpenAttribute atl.Attributes) +let isAnyAttributeAutoOpen (attributes: SynAttributes) = findSynAttribute "AutoOpen" attributes /// Checks to see if the top level ModuleOrNamespace exposes content that could be inferred by any of the subsequent files. /// This can happen when a `namespace global` is used, or when a module (with a single ident name) has the `[]` attribute. diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index c0f9a8a4f1a..f16be8658dd 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1736,7 +1736,7 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form 3558,chkExplicitFieldsDeclarationsOnStaticClasses,"If a type uses both [] and [] attributes, it means it is static. Explicit field declarations are not allowed." 3559,typrelNeverRefinedAwayFromTop,"A type has been implicitly inferred as 'obj', which may be unintended. Consider adding explicit type annotations. You can disable this warning by using '#nowarn \"3559\"' or '--nowarn:3559'." 3560,tcCopyAndUpdateRecordChangesAllFields,"This copy-and-update record expression changes all fields of record type '%s'. Consider using the record construction syntax instead." -3561,chkAutoOpenAttributeInTypeAbbrev,"FSharp.Core.AutoOpenAttribute should not be aliased." +3561,chkAttributeAliased,"%s should not be aliased." 3562,parsUnexpectedEndOfFileElif,"Unexpected end of input in 'else if' or 'elif' branch of conditional expression. Expected 'elif then ' or 'else if then '." 3563,lexInvalidIdentifier,"This is not a valid identifier" 3564,parsMissingUnionCaseName,"Missing union case name" @@ -1790,3 +1790,4 @@ featureUseTypeSubsumptionCache,"Use type conversion cache during compilation" featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase identifiers in binding patterns" 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'" featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted" +featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters" diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 0e2783796af..5401ea26a1b 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -97,6 +97,7 @@ type LanguageFeature = | DontWarnOnUppercaseIdentifiersInBindingPatterns | UseTypeSubsumptionCache | DeprecatePlacesWhereSeqCanBeOmitted + | SupportValueOptionsAsOptionalParameters /// LanguageVersion management type LanguageVersion(versionText) = @@ -225,6 +226,7 @@ type LanguageVersion(versionText) = LanguageFeature.AllowObjectExpressionWithoutOverrides, previewVersion LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns, previewVersion LanguageFeature.DeprecatePlacesWhereSeqCanBeOmitted, previewVersion + LanguageFeature.SupportValueOptionsAsOptionalParameters, previewVersion ] static let defaultLanguageVersion = LanguageVersion("default") @@ -385,6 +387,7 @@ type LanguageVersion(versionText) = FSComp.SR.featureDontWarnOnUppercaseIdentifiersInBindingPatterns () | LanguageFeature.UseTypeSubsumptionCache -> FSComp.SR.featureUseTypeSubsumptionCache () | LanguageFeature.DeprecatePlacesWhereSeqCanBeOmitted -> FSComp.SR.featureDeprecatePlacesWhereSeqCanBeOmitted () + | LanguageFeature.SupportValueOptionsAsOptionalParameters -> FSComp.SR.featureSupportValueOptionsAsOptionalParameters () /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index bc361ba1337..90572888001 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -88,6 +88,7 @@ type LanguageFeature = | DontWarnOnUppercaseIdentifiersInBindingPatterns | UseTypeSubsumptionCache | DeprecatePlacesWhereSeqCanBeOmitted + | SupportValueOptionsAsOptionalParameters /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 7b392487adb..ffb9bd65647 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -107,6 +107,20 @@ let rec pushUnaryArg expr arg = errorR (Error(FSComp.SR.tcDotLambdaAtNotSupportedExpression (), expr.Range)) expr +/// CAUTION: This function operates over the untyped tree, so should be used only when absolutely necessary. It doesn't verify assembly origine nor does it respect type aliases. +/// Also, keep in mind that it will only check last part of the assembly (with or without the `Attribute` suffix). +let inline findSynAttribute (attrName: string) (synAttrs: SynAttributes) = + let attributesToSearch = + if attrName.EndsWith("Attribute") then + set [ attrName; attrName.Substring(0, attrName.Length - 9) ] + else + set [ attrName; attrName + "Attribute" ] + + synAttrs + |> List.exists (fun synAttr -> + synAttr.Attributes + |> List.exists (fun attr -> attributesToSearch.Contains(attr.TypeName.LongIdent |> List.last |> _.idText))) + [] let (|SynSingleIdent|_|) x = match x with diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 3ca2b58be43..49190452b4f 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -44,6 +44,8 @@ val mkSynCompGenSimplePatVar: id: Ident -> SynSimplePat val pushUnaryArg: expr: SynExpr -> arg: Ident -> SynExpr +val inline findSynAttribute: attrName: string -> synAttrs: SynAttributes -> bool + /// Match a long identifier, including the case for single identifiers which gets a more optimized node in the syntax tree. [] val (|LongOrSingleIdent|_|): diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d383130d0ee..ca7292c6369 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3887,10 +3887,16 @@ let mkSome g ty arg m = mkUnionCaseExpr(mkSomeCase g, [ty], [arg], m) let mkNone g ty m = mkUnionCaseExpr(mkNoneCase g, [ty], [], m) +let mkValueNoneCase (g: TcGlobals) = mkUnionCaseRef g.valueoption_tcr_canon "ValueNone" + let mkValueSomeCase (g: TcGlobals) = mkUnionCaseRef g.valueoption_tcr_canon "ValueSome" let mkAnySomeCase g isStruct = (if isStruct then mkValueSomeCase g else mkSomeCase g) +let mkValueSome g ty arg m = mkUnionCaseExpr(mkValueSomeCase g, [ty], [arg], m) + +let mkValueNone g ty m = mkUnionCaseExpr(mkValueNoneCase g, [ty], [], m) + type ValRef with member vref.IsDispatchSlot = match vref.MemberInfo with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 8b2cf510ac9..bda6c2c3187 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1911,12 +1911,21 @@ val mkNoneCase: TcGlobals -> UnionCaseRef /// Create the union case 'Some(expr)' for an option type val mkSomeCase: TcGlobals -> UnionCaseRef +/// Create the struct union case 'ValueNone' for a voption type +val mkValueNoneCase: TcGlobals -> UnionCaseRef + /// Create the struct union case 'ValueSome(expr)' for a voption type val mkValueSomeCase: TcGlobals -> UnionCaseRef /// Create the struct union case 'Some' or 'ValueSome(expr)' for a voption type val mkAnySomeCase: TcGlobals -> isStruct: bool -> UnionCaseRef +/// Create the expression 'ValueSome(expr)' +val mkValueSome: TcGlobals -> TType -> Expr -> range -> Expr + +/// Create the struct expression 'ValueNone' for an voption type +val mkValueNone: TcGlobals -> TType -> range -> Expr + /// Create the expression '[]' for a list type val mkNil: TcGlobals -> range -> TType -> Expr diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 044a9c461f4..750326328a6 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -37,9 +37,9 @@ Pokud typ používá atribut [<Sealed>] i [<AbstractClass>], znamená to, že je statický. Další konstruktor není povolený. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute by neměl mít alias. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ reprezentace struktury aktivních vzorů + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Vlastnosti testu případu sjednocení diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index b8e33044bc8..a32c7962125 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -37,9 +37,9 @@ Wenn ein Typ sowohl das Attribute [<Sealed>] wie auch [<AbstractClass>] verwendet, bedeutet dies, dass er statisch ist. Ein zusätzlicher Konstruktor ist nicht zulässig. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute darf kein Alias sein. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ Strukturdarstellung für aktive Muster + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Eigenschaften von Union-Falltests diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index cbb8274fd80..37b48d83ec3 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -37,9 +37,9 @@ Si un tipo usa los atributos [<Sealed>] y [<AbstractClass>], significa que es estático. No se permite un constructor adicional. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute no debe tener alias. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ representación de struct para modelos activos + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Propiedades de prueba de caso de unión diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 7424a9be7be..333b320a1eb 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -37,9 +37,9 @@ Si un type utilise les attributs [<Sealed>] et [<AbstractClass>], cela signifie qu’il est statique. Un constructeur supplémentaire n’est pas autorisé. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute ne doit pas avoir d'alias. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ représentation de structure pour les modèles actifs + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Propriétés du test de cas d’union diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 78e635516fe..7d5c4093770 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -37,9 +37,9 @@ Se un tipo usa entrambi gli attributi [<Sealed>] e [<AbstractClass>], significa che è statico. Non sono ammessi costruttori aggiuntivi. - - FSharp.Core.AutoOpenAttribute should not be aliased. - Non sono consentiti alias per FSharp.Core.AutoOpenAttribute. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ rappresentazione struct per criteri attivi + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Proprietà test case di unione diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 47e87ffde18..35898789fc9 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -37,9 +37,9 @@ 型が [<Sealed>] と [<AbstractClass>] の両方の属性を使用する場合、それは静的であることを意味します。追加のコンストラクターは許可されていません。 - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute にエイリアスを設定することはできません。 + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ アクティブなパターンの構造体表現 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties ユニオン ケースのテスト プロパティ diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index c30cc41398c..fa1d20d2ccf 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -37,9 +37,9 @@ 형식이 [<Sealed>] 및 [<AbstractClass>] 특성을 모두 사용하는 경우 정적임을 의미합니다. 추가 생성자는 허용되지 않습니다. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute는 별칭을 지정할 수 없습니다. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ 활성 패턴에 대한 구조체 표현 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties 공용 구조체 사례 테스트 속성 diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index b1a404bc0b0..404c55b08c1 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -37,9 +37,9 @@ Jeśli typ używa obu [<Sealed>] i [< AbstractClass>] atrybutów, oznacza to, że jest statyczny. Konstruktor jest również niedozwolony. - - FSharp.Core.AutoOpenAttribute should not be aliased. - Element FSharp.Core.AutoOpenAttribute nie powinien mieć aliasu. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ reprezentacja struktury aktywnych wzorców + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Właściwości testowe przypadku unii diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index c3be9642f81..7f47aab104e 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -37,9 +37,9 @@ Se um tipo usa os atributos [<Sealed>] e [<AbstractClass>], significa que é estático. Construtor adicional não é permitido. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute não deve ter alias. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ representação estrutural para padrões ativos + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Propriedades de teste de caso de união diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 9da18bd9abf..1b4631d4070 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -37,9 +37,9 @@ Если тип использует атрибуты [<Sealed>] и [<AbstractClass>], это означает, что он статический. Дополнительный конструктор не разрешен. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute не должен быть псевдонимом. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ представление структуры для активных шаблонов + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Свойства теста союзного случая diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 4b383d721d7..67ebaebfab3 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -37,9 +37,9 @@ Bir tür, hem [<Sealed>] hem de [< AbstractClass>] özniteliklerini kullanıyorsa bu statik olduğu anlamına gelir. Ek oluşturucuya izin verilmez. - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute diğer adlı olamaz. + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ etkin desenler için yapı gösterimi + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties Birleşim durumu test özellikleri diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index d38b026f117..4b7924b2f93 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -37,9 +37,9 @@ 如果类型同时使用 [<Sealed>] 和 [<AbstractClass>] 属性，则表示它是静态的。不允许使用其他构造函数。 - - FSharp.Core.AutoOpenAttribute should not be aliased. - FSharp.Core.AutoOpenAttribute 不应为别名。 + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ 活动模式的结构表示形式 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties 联合用例测试属性 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index cbb001aef87..5937af812f0 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -37,9 +37,9 @@ 如果類型同時使用 [<Sealed>] 和 [<AbstractClass>] 屬性，表示其為靜態。不允許其他建構函式。 - - FSharp.Core.AutoOpenAttribute should not be aliased. - 不應別名化 FSharp.Core.AutoOpenAttribute。 + + {0} should not be aliased. + {0} should not be aliased. @@ -612,6 +612,11 @@ 現用模式的結構表示法 + + Support ValueOption as valid type for optional member parameters + Support ValueOption as valid type for optional member parameters + + Union case test properties 聯集案例測試屬性 diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index 7c5f12f764d..7f1b0a122ad 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -183,7 +183,7 @@ namespace Microsoft.FSharp.Core inherit Attribute() member _.CompiledName = compiledName - [] + [] [] type StructAttribute() = inherit Attribute() diff --git a/src/FSharp.Core/prim-types.fsi b/src/FSharp.Core/prim-types.fsi index 15264b3a14e..a992a0204e0 100644 --- a/src/FSharp.Core/prim-types.fsi +++ b/src/FSharp.Core/prim-types.fsi @@ -200,7 +200,7 @@ namespace Microsoft.FSharp.Core /// Adding this attribute to a type causes it to be represented using a CLI struct. /// /// Attributes - [] + [] [] type StructAttribute = inherit Attribute diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs index 48cbd63e1e2..c0604630d56 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OptionalArguments/OptionalArguments.fs @@ -115,4 +115,498 @@ module MemberDefinitions_OptionalArguments = |> verifyCompileAndRun |> shouldSucceed + [] + let ``Optional Arguments can't be a ValueOption+StructAttribute attribute with langversion=9`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M() + 0 + """ + source + |> asLibrary + |> withLangVersion90 + |> withNoWarn 25 + |> compile + |> shouldFail + |> withDiagnostics [ + Error 1, Line 6, Col 11, Line 6, Col 22, "This expression was expected to have type + ''a option' +but here has type + ''b voption' " + Error 1, Line 7, Col 11, Line 7, Col 20, "This expression was expected to have type + ''a option' +but here has type + ''b voption' "] + + [] + let ``Optional Arguments wrap Option`` () = + let source = + FSharp """ +module Program +type X() = + static member M(?x) = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X.M(Some 1) + X.M(None) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some Some 1"; "Some None"; "Some 1"; "None"] + + [] + let ``Optional Arguments wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X() = + static member M(?x) = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some ValueSome 1"; "Some ValueNone"; "Some 1"; "None"] + + [] + let ``Optional Struct Arguments wrap Option`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(Some 1) + X.M(None) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome Some 1"; "VSome None"; "VSome 1"; "VNone"] + + [] + let ``Optional Struct Arguments wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M(1) + X.M() + 0 + """ + source + |> asExe + |> withLangVersionPreview + |> withNoWarn 25 + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + + + [] + let ``Optional Arguments can be a ValueOption+StructAttribute attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M(1) + X.M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + |> verifyIL [""" +.method public static void M(valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1 x) cil managed +{ + .param [1] + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.OptionalArgumentAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.StructAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (!!a V_0, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_1, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4 V_2) + IL_0000: ldarga.s x + IL_0002: call instance int32 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Tag() + IL_0007: ldc.i4.0 + IL_0008: bne.un.s IL_000c + + IL_000a: br.s IL_0032 + + IL_000c: ldarga.s x + IL_000e: call instance !0 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Item() + IL_0013: stloc.0 + IL_0014: ldstr "VSome %A" + IL_0019: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit,!!a>::.ctor(string) + IL_001e: stloc.1 + IL_001f: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0024: ldloc.1 + IL_0025: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter>(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_002a: ldloc.0 + IL_002b: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0030: pop + IL_0031: ret + + IL_0032: ldstr "VNone" + IL_0037: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5::.ctor(string) + IL_003c: stloc.2 + IL_003d: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0042: ldloc.2 + IL_0043: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_0048: pop + IL_0049: ret +} + """] + + + [] + let ``Optional Arguments can be a ValueOption+Struct attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X() = + static member M([] ?x) = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X.M(ValueSome 1) + X.M(ValueNone) + X.M(1) + X.M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + |> verifyIL [""" +.method public static void M(valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1 x) cil managed +{ + .param [1] + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.OptionalArgumentAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.StructAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (!!a V_0, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_1, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4 V_2) + IL_0000: ldarga.s x + IL_0002: call instance int32 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Tag() + IL_0007: ldc.i4.0 + IL_0008: bne.un.s IL_000c + + IL_000a: br.s IL_0032 + + IL_000c: ldarga.s x + IL_000e: call instance !0 valuetype [FSharp.Core]Microsoft.FSharp.Core.FSharpValueOption`1::get_Item() + IL_0013: stloc.0 + IL_0014: ldstr "VSome %A" + IL_0019: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [runtime]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit,!!a>::.ctor(string) + IL_001e: stloc.1 + IL_001f: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0024: ldloc.1 + IL_0025: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter>(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_002a: ldloc.0 + IL_002b: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0030: pop + IL_0031: ret + + IL_0032: ldstr "VNone" + IL_0037: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5::.ctor(string) + IL_003c: stloc.2 + IL_003d: call class [netstandard]System.IO.TextWriter [netstandard]System.Console::get_Out() + IL_0042: ldloc.2 + IL_0043: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter(class [runtime]System.IO.TextWriter, + class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_0048: pop + IL_0049: ret +} + """] + + [] + let ``Optional Arguments in constructor wrap Option`` () = + let source = + FSharp """ +module Program +type X<'T>(?x: 'T) = + member _.M() = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X(Some 1).M() + X(None).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some Some 1"; "Some None"; "Some 1"; "None"] + + [] + let ``Optional Arguments in constructor wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X<'T>(?x: 'T) = + member _.M() = + match x with + | Some x -> printfn "Some %A" x + | None -> printfn "None" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["Some ValueSome 1"; "Some ValueNone"; "Some 1"; "None"] + + [] + let ``Optional Struct Arguments in constructor wrap Option`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(Some 1).M() + X(None).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome Some 1"; "VSome None"; "VSome 1"; "VNone"] + + [] + let ``Optional Struct Arguments in constructor wrap ValueOption`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + + [] + let ``Optional Arguments in constructor can be a ValueOption+StructAttribute attribute with langversion=preview`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersionPreview + |> asExe + |> compile + + compilation + |> shouldSucceed + |> run + |> shouldSucceed + |> withOutputContainsAllInOrder ["VSome ValueSome 1"; "VSome ValueNone"; "VSome 1"; "VNone"] + + [] + let ``Optional Arguments in constructor can't be a ValueOption+StructAttribute attribute with langversion=90`` () = + let source = + FSharp """ +module Program +type X<'T>([] ?x: 'T) = + member _.M() = + match x with + | ValueSome x -> printfn "VSome %A" x + | ValueNone -> printfn "VNone" + +[] +let main _ = + X(ValueSome 1).M() + X(ValueNone).M() + X(1).M() + X().M() + 0 + """ + let compilation = + source + |> withLangVersion90 + |> withNoWarn 25 + |> asLibrary + |> compile + + compilation + |> shouldFail + |> withDiagnostics [ + Error 1, Line 6, Col 11, Line 6, Col 22, "This expression was expected to have type + ''T option' +but here has type + ''a voption' " + Error 1, Line 7, Col 11, Line 7, Col 20, "This expression was expected to have type + ''T option' +but here has type + ''a voption' " + ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs new file mode 100644 index 00000000000..2edc2107284 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAttributeAlias.fs @@ -0,0 +1,39 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Conformance.BasicGrammarElements + +open Xunit +open FSharp.Test.Compiler + +module WarnForAttributeAlias = + [] + let ``Warn user when aliasing FSharp_Core_AutoOpenAttribute`` () = + Fsx """ +type ByItsOwnNatureUnBottledAttribute = Microsoft.FSharp.Core.AutoOpenAttribute + +[] +module Foo = + let bar = 0 +""" + |> withLangVersion80 + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 3561, Line 2, Col 6, Line 2, Col 38, "Microsoft.FSharp.Core.AutoOpenAttribute should not be aliased."); + ] + + [] + let ``Warn user when aliasing FSharp_Core_StructAttribute`` () = + Fsx """ +type ByItsOwnNatureUnBottledAttribute = StructAttribute + +[] +module Foo = + let bar = 0 +""" + |> withLangVersion80 + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 3561, Line 2, Col 6, Line 2, Col 38, "Microsoft.FSharp.Core.StructAttribute should not be aliased."); + ] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs deleted file mode 100644 index b1d60d36842..00000000000 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/TypeAbbreviations/WarnForAutoOpenAttributeAlias.fs +++ /dev/null @@ -1,23 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Conformance.BasicGrammarElements - -open Xunit -open FSharp.Test.Compiler - -module WarnForAutoOpenAttributeAlias = - [] - let ``Warn user when aliasing FSharp_Core_AutoOpenAttribute`` () = - Fsx """ -type ByItsOwnNatureUnBottledAttribute = Microsoft.FSharp.Core.AutoOpenAttribute - -[] -module Foo = - let bar = 0 -""" - |> withLangVersion80 - |> compile - |> shouldFail - |> withDiagnostics [ - (Warning 3561, Line 2, Col 6, Line 2, Col 38, "FSharp.Core.AutoOpenAttribute should not be aliased."); - ] diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index e8f044ed2f4..3ff3f070dc0 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -73,7 +73,7 @@ - +