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 c7d7b11d770..e216d5a0785 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md @@ -8,6 +8,7 @@ ### Added +* Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769)) ### Changed diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index e9860a76efa..645f43fe3cb 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -1958,7 +1958,8 @@ and CheckAttribArgExpr cenv env expr = | Const.Single _ | Const.Char _ | Const.Zero - | Const.String _ -> () + | Const.String _ + | Const.Decimal _ -> () | _ -> if cenv.reportErrors then errorR (Error (FSComp.SR.tastNotAConstantExpression(), m)) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 82572ea888a..15ca0e024aa 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8563,10 +8563,15 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt = let ilFieldDef = mkILStaticField (fspec.Name, fty, None, None, access) + let isDecimalConstant = + match vref.LiteralValue with + | Some(Const.Decimal _) -> true + | _ -> false + let ilFieldDef = match vref.LiteralValue with - | Some konst -> ilFieldDef.WithLiteralDefaultValue(Some(GenFieldInit m konst)) - | None -> ilFieldDef + | Some konst when not isDecimalConstant -> ilFieldDef.WithLiteralDefaultValue(Some(GenFieldInit m konst)) + | _ -> ilFieldDef let ilFieldDef = let isClassInitializer = (cgbuf.MethodName = ".cctor") @@ -8578,6 +8583,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt = || not isClassInitializer || hasLiteralAttr ) + || isDecimalConstant ) let ilAttribs = @@ -8590,6 +8596,64 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt = let ilAttribs = GenAdditionalAttributesForTy g vspec.Type @ ilAttribs + let ilAttribs = + if isDecimalConstant then + match vref.LiteralValue with + | Some(Const.Decimal d) -> + match System.Decimal.GetBits d with + | [| lo; med; hi; signExp |] -> + let scale = (min (((signExp &&& 0xFF0000) >>> 16) &&& 0xFF) 28) |> byte + let sign = if (signExp &&& 0x80000000) <> 0 then 1uy else 0uy + + let attrib = + mkILCustomAttribute ( + g.attrib_DecimalConstantAttribute.TypeRef, + [ + g.ilg.typ_Byte + g.ilg.typ_Byte + g.ilg.typ_Int32 + g.ilg.typ_Int32 + g.ilg.typ_Int32 + ], + [ + ILAttribElem.Byte scale + ILAttribElem.Byte sign + ILAttribElem.UInt32(uint32 hi) + ILAttribElem.UInt32(uint32 med) + ILAttribElem.UInt32(uint32 lo) + ], + [] + ) + + let ilInstrs = + [ + mkLdcInt32 lo + mkLdcInt32 med + mkLdcInt32 hi + mkLdcInt32 (int32 sign) + mkLdcInt32 (int32 scale) + mkNormalNewobj ( + mkILCtorMethSpecForTy ( + fspec.ActualType, + [ + g.ilg.typ_Int32 + g.ilg.typ_Int32 + g.ilg.typ_Int32 + g.ilg.typ_Bool + g.ilg.typ_Byte + ] + ) + ) + mkNormalStsfld fspec + ] + + CG.EmitInstrs cgbuf (pop 0) (Push0) ilInstrs + [ attrib ] + | _ -> failwith "unreachable" + | _ -> failwith "unreachable" + else + ilAttribs + let ilFieldDef = ilFieldDef.With(customAttrs = mkILCustomAttrs (ilAttribs @ [ g.DebuggerBrowsableNeverAttribute ])) diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 2c065437f2b..531ef79d264 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1490,6 +1490,7 @@ type TcGlobals( member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" member val attrib_SkipLocalsInitAttribute = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute" + member val attrib_DecimalConstantAttribute = findSysAttrib "System.Runtime.CompilerServices.DecimalConstantAttribute" member val attribs_Unsupported = v_attribs_Unsupported member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 950d5217500..b7d5a892d06 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -474,6 +474,8 @@ type internal TcGlobals = member attrib_SkipLocalsInitAttribute: BuiltinAttribInfo + member attrib_DecimalConstantAttribute: BuiltinAttribInfo + member attrib_StructAttribute: BuiltinAttribInfo member attrib_StructLayoutAttribute: BuiltinAttribInfo diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e7c4576b24e..143ea19432f 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10020,7 +10020,7 @@ let EvalArithUnOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt3 | _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m)) with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m)) -let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64, opSingle, opDouble) (arg1: Expr) (arg2: Expr) = +let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64, opSingle, opDouble, opDecimal) (arg1: Expr) (arg2: Expr) = // At compile-time we check arithmetic let m = unionRanges arg1.Range arg2.Range try @@ -10035,6 +10035,7 @@ let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt | Expr.Const (Const.UInt64 x1, _, ty), Expr.Const (Const.UInt64 x2, _, _) -> Expr.Const (Const.UInt64 (opUInt64 x1 x2), m, ty) | Expr.Const (Const.Single x1, _, ty), Expr.Const (Const.Single x2, _, _) -> Expr.Const (Const.Single (opSingle x1 x2), m, ty) | Expr.Const (Const.Double x1, _, ty), Expr.Const (Const.Double x2, _, _) -> Expr.Const (Const.Double (opDouble x1 x2), m, ty) + | Expr.Const (Const.Decimal x1, _, ty), Expr.Const (Const.Decimal x2, _, _) -> Expr.Const (Const.Decimal (opDecimal x1 x2), m, ty) | _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m)) with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m)) @@ -10066,9 +10067,10 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = | Const.Single _ | Const.Char _ | Const.Zero - | Const.String _ -> + | Const.String _ + | Const.Decimal _ -> x - | Const.Decimal _ | Const.IntPtr _ | Const.UIntPtr _ | Const.Unit -> + | Const.IntPtr _ | Const.UIntPtr _ | Const.Unit -> errorR (Error ( FSComp.SR.tastNotAConstantExpression(), m)) x @@ -10084,7 +10086,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = match v1 with | IntegerConstExpr -> - EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||), ignore2, ignore2) v1 (EvalAttribArgExpr suppressLangFeatureCheck g arg2) + EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||), ignore2, ignore2, ignore2) v1 (EvalAttribArgExpr suppressLangFeatureCheck g arg2) | _ -> errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)) x @@ -10099,7 +10101,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = Expr.Const (Const.Char (x1 + x2), m, ty) | _ -> checkFeature() - EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) v1 v2 + EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) v1 v2 | SpecificBinopExpr g g.unchecked_subtraction_vref (arg1, arg2) -> checkFeature() let v1, v2 = EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1, EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2 @@ -10108,16 +10110,16 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = | Expr.Const (Const.Char x1, m, ty), Expr.Const (Const.Char x2, _, _) -> Expr.Const (Const.Char (x1 - x2), m, ty) | _ -> - EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) v1 v2 + EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) v1 v2 | SpecificBinopExpr g g.unchecked_multiply_vref (arg1, arg2) -> checkFeature() - EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) | SpecificBinopExpr g g.unchecked_division_vref (arg1, arg2) -> checkFeature() - EvalArithBinOp ((/), (/), (/), (/), (/), (/), (/), (/), (/), (/)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + EvalArithBinOp ((/), (/), (/), (/), (/), (/), (/), (/), (/), (/), (/)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) | SpecificBinopExpr g g.unchecked_modulus_vref (arg1, arg2) -> checkFeature() - EvalArithBinOp ((%), (%), (%), (%), (%), (%), (%), (%), (%), (%)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + EvalArithBinOp ((%), (%), (%), (%), (%), (%), (%), (%), (%), (%), (%)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) | SpecificBinopExpr g g.bitwise_shift_left_vref (arg1, arg2) -> checkFeature() EvalArithShiftOp ((<<<), (<<<), (<<<), (<<<), (<<<), (<<<), (<<<), (<<<)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) @@ -10130,7 +10132,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = match v1 with | IntegerConstExpr -> - EvalArithBinOp ((&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + EvalArithBinOp ((&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), ignore2, ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) | _ -> errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)) x @@ -10140,7 +10142,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = match v1 with | IntegerConstExpr -> - EvalArithBinOp ((^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + EvalArithBinOp ((^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), ignore2, ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) | _ -> errorR (Error (FSComp.SR.tastNotAConstantExpression(), x.Range)) x @@ -10150,7 +10152,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = match v1 with | FloatConstExpr -> - EvalArithBinOp (ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ( ** ), ( ** )) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + EvalArithBinOp (ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ( ** ), ( ** ), ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) | _ -> errorR (Error (FSComp.SR.tastNotAConstantExpression(), x.Range)) x diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs index d67f22efdc8..c0a19c9ad3e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs @@ -144,13 +144,12 @@ module LetBindings_Basic = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 267, Line 11, Col 18, Line 11, Col 19, "This is not a valid constant expression or custom attribute value") - (Error 837, Line 11, Col 13, Line 11, Col 31, "This is not a valid constant expression") - (Error 267, Line 14, Col 13, Line 14, Col 17, "This is not a valid constant expression or custom attribute value") - (Error 267, Line 17, Col 13, Line 17, Col 15, "This is not a valid constant expression or custom attribute value") - (Error 267, Line 20, Col 13, Line 20, Col 17, "This is not a valid constant expression or custom attribute value") - (Error 267, Line 23, Col 13, Line 23, Col 18, "This is not a valid constant expression or custom attribute value") - (Warning 3178, Line 26, Col 13, Line 26, Col 26, "This is not valid literal expression. The [] attribute will be ignored.") + (Error 267, Line 10, Col 18, Line 10, Col 19, "This is not a valid constant expression or custom attribute value") + (Error 837, Line 10, Col 13, Line 10, Col 31, "This is not a valid constant expression") + (Error 267, Line 16, Col 13, Line 16, Col 15, "This is not a valid constant expression or custom attribute value") + (Error 267, Line 19, Col 13, Line 19, Col 17, "This is not a valid constant expression or custom attribute value") + (Error 267, Line 22, Col 13, Line 22, Col 18, "This is not a valid constant expression or custom attribute value") + (Warning 3178, Line 25, Col 13, Line 25, Col 26, "This is not valid literal expression. The [] attribute will be ignored.") ] // SOURCE=E_Pathological01.fs SCFLAGS=--test:ErrorRanges # E_Pathological01.fs @@ -303,4 +302,4 @@ type C() = |> withDiagnostics [ (Warning 3582, Line 4, Col 5, Line 4, Col 12, "This is a function definition that shadows a union case. If this is what you want, ignore or suppress this warning. If you want it to be a union case deconstruction, add parentheses.") (Warning 3582, Line 5, Col 5, Line 5, Col 11, "This is a function definition that shadows a union case. If this is what you want, ignore or suppress this warning. If you want it to be a union case deconstruction, add parentheses.") - ] + ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/E_Literals04.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/E_Literals04.fs index aa3395e0b6f..c253d840657 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/E_Literals04.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/E_Literals04.fs @@ -1,11 +1,10 @@ // #Regression #Conformance #DeclarationElements #LetBindings -//This is not a valid constant expression or custom attribute value$ -//This is not a valid constant expression$ -//This is not a valid constant expression or custom attribute value$ -//This is not a valid constant expression or custom attribute value$ -//This is not a valid constant expression or custom attribute value$ -//This is not a valid constant expression or custom attribute value$ -//This is not valid literal expression. The \[\] attribute will be ignored\.$ +//This is not a valid constant expression or custom attribute value$ +//This is not a valid constant expression$ +//This is not a valid constant expression or custom attribute value$ +//This is not a valid constant expression or custom attribute value$ +//This is not a valid constant expression or custom attribute value$ +//This is not valid literal expression. The \[\] attribute will be ignored\.$ [] let lit01 = (let x = "2" in x) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/Decimal.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/Decimal.fs new file mode 100644 index 00000000000..1f168db110f --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/Decimal.fs @@ -0,0 +1,26 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Conformance.PatternMatching + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +module Decimal = + + [] + let ``Decimal - literal01.fs - --test:ErrorRanges`` compilation = + compilation + |> asFsx + |> withOptions ["--test:ErrorRanges";] + |> compile + |> shouldSucceed + + [] + let ``Decimal - incompleteMatchesLiteral01.fs - --test:ErrorRanges`` compilation = + compilation + |> asFs + |> withOptions ["--test:ErrorRanges"] + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Warning 25, Line 7, Col 11, Line 7, Col 13, "Incomplete pattern matches on this expression. For example, the value '3M' may indicate a case not covered by the pattern(s).") \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/incompleteMatchesLiteral01.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/incompleteMatchesLiteral01.fs new file mode 100644 index 00000000000..2397eeee743 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/incompleteMatchesLiteral01.fs @@ -0,0 +1,11 @@ +[] +let One = 1m +[] +let Two = 2m + +let test() = + match 3m with + | 0m -> false + | One | Two -> false + +exit 0 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/literal01.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/literal01.fs new file mode 100644 index 00000000000..764958b9bd7 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/literal01.fs @@ -0,0 +1,26 @@ +// #Conformance #PatternMatching +#light + +// Pattern match decimal literals + +[] +let Decimal1 = 5m + +[] +let Decimal2 = 42.42m + +let testDecimal x = + match x with + | Decimal1 -> 1 + | Decimal2 -> 2 + | _ -> 0 + +if testDecimal 1m <> 0 then exit 1 + +if testDecimal Decimal1 <> 1 then exit 1 +if testDecimal 5m <> 1 then exit 1 + +if testDecimal Decimal2 <> 2 then exit 1 +if testDecimal 42.42m <> 2 then exit 1 + +exit 0 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs index 9ac49148a78..d2dc41a3235 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs @@ -176,36 +176,95 @@ let [] x = System.Int32.MaxValue + 1 } [] - let ``Compilation fails when using decimal arithmetic in literal``() = + let ``Arithmetic can be used for constructing decimal literals``() = FSharp """ module LiteralArithmetic -let [] x = 1m + 1m +[] +let x = 1m + 2m """ |> withLangVersion80 |> compile - |> shouldFail - |> withResults [ - { Error = Error 267 - Range = { StartLine = 4 - StartColumn = 21 - EndLine = 4 - EndColumn = 23 } - Message = "This is not a valid constant expression or custom attribute value" } - { Error = Error 267 - Range = { StartLine = 4 - StartColumn = 26 - EndLine = 4 - EndColumn = 28 } - Message = "This is not a valid constant expression or custom attribute value" } - { Error = Error 267 - Range = { StartLine = 4 - StartColumn = 21 - EndLine = 4 - EndColumn = 28 } - Message = "This is not a valid constant expression or custom attribute value" } + |> shouldSucceed + |> verifyIL [ + """.field public static initonly valuetype [runtime]System.Decimal x""" + """.custom instance void [runtime]System.Runtime.CompilerServices.DecimalConstantAttribute::.ctor(uint8, + uint8, + int32, + int32, + int32) = ( 01 00 00 00 00 00 00 00 00 00 00 00 03 00 00 00 + 00 00 )""" + """.maxstack 8""" + """IL_0000: ldc.i4.3""" + """IL_0001: ldc.i4.0""" + """IL_0002: ldc.i4.0""" + """IL_0003: ldc.i4.0""" + """IL_0004: ldc.i4.0""" + """IL_0005: newobj instance void [runtime]System.Decimal::.ctor(int32, + int32, + int32, + bool, + uint8)""" + """IL_000a: stsfld valuetype [runtime]System.Decimal LiteralArithmetic::x""" + """IL_000f: ret""" + ] + + [] + let ``Pattern matching decimal literal``() = + FSharp """ +module PatternMatch + +[] +let x = 5m + +let test () = + match x with + | 5m -> 0 + | _ -> 1 + """ + |> withLangVersion80 + |> compile + |> shouldSucceed + |> verifyIL [ + """.field public static initonly valuetype [runtime]System.Decimal x""" + """ .custom instance void [runtime]System.Runtime.CompilerServices.DecimalConstantAttribute::.ctor(uint8, + uint8, + int32, + int32, + int32) = ( 01 00 00 00 00 00 00 00 00 00 00 00 05 00 00 00 + 00 00 )""" + """IL_0016: call bool [netstandard]System.Decimal::op_Equality(valuetype [netstandard]System.Decimal, + valuetype [netstandard]System.Decimal)""" + """.maxstack 8""" + """IL_0000: ldc.i4.5""" + """IL_0001: ldc.i4.0""" + """IL_0002: ldc.i4.0""" + """IL_0003: ldc.i4.0""" + """IL_0004: ldc.i4.0""" + """IL_0005: newobj instance void [runtime]System.Decimal::.ctor(int32, + int32, + int32, + bool, + uint8)""" + """IL_000a: stsfld valuetype [runtime]System.Decimal PatternMatch::x""" + """IL_000f: ret""" ] + [] + let ``Multiple decimals literals can be created``() = + FSharp """ +module DecimalLiterals + +[] +let x = 41m + +[] +let y = 42m + """ + |> withLangVersion80 + |> compile + |> shouldSucceed + [] let ``Compilation fails when using arithmetic with a non-literal in literal``() = FSharp """ diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 03ff28e096a..4b50b28aa12 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -116,6 +116,7 @@ + @@ -258,6 +259,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/Literals.fs b/tests/FSharp.Compiler.ComponentTests/Interop/Literals.fs new file mode 100644 index 00000000000..5eeea2822b4 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Interop/Literals.fs @@ -0,0 +1,35 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Interop + +open Xunit +open FSharp.Test.Compiler + +module ``Literals interop`` = + + [] + let ``Instantiate F# decimal literal from C#`` () = + let FSLib = + FSharp """ +namespace Interop.FS + +module DecimalLiteral = + [] + let x = 7m + """ + |> withName "FSLib" + + let app = + CSharp """ +using System; +using Interop.FS; +public class C { + public Decimal y = DecimalLiteral.x; +} + """ + |> withReferences [FSLib] + |> withName "CSharpApp" + + app + |> compile + |> shouldSucceed \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs index dc98a4be095..90a4a188e4f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs @@ -39,3 +39,22 @@ let z : unit = |> withLangVersion50 |> compileAndRun |> shouldSucceed + + [] + let ``Quotation on decimal literal compiles and runs`` () = + FSharp """ +open Microsoft.FSharp.Quotations.DerivedPatterns + +[] +let x = 7m + +let expr = <@ x @> + +match expr with +| Decimal n -> printfn "%M" n +| _ -> failwith (string expr) + """ + |> asExe + |> withLangVersion80 + |> compileAndRun + |> shouldSucceed \ No newline at end of file