Enforce attribute targets on let values

src/Compiler/Checking/CheckExpressions.fs

@@ -10535,7 +10535,20 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
 
         let envinner = {envinner with eCallerMemberName = callerName }
 
-        let attrTgt = declKind.AllowedAttribTargets memberFlagsOpt
+        let attrTgt =
+            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargetsOnLetValues) then
+                match pat, rhsExpr with
+                | SynPat.Named _ , SynExpr.Lambda _
+                | SynPat.Named _ , SynExpr.App _
+                | SynPat.Named _ , SynExpr.MatchLambda _ -> AttributeTargets.Method ||| AttributeTargets.ReturnValue
+                | SynPat.Named  _, _ when not declaredTypars.IsEmpty -> AttributeTargets.Method ||| AttributeTargets.ReturnValue
+                | SynPat.Named _ , SynExpr.Ident(ident = ident) when ident.idText = "id" -> AttributeTargets.Method ||| AttributeTargets.ReturnValue
+
+                | SynPat.Tuple _ , _
+                | SynPat.Named _, _ when isNil declaredTypars -> AttributeTargets.FieldDecl
+                | _ -> declKind.AllowedAttribTargets memberFlagsOpt
+            else
+                declKind.AllowedAttribTargets memberFlagsOpt
 
         let isFixed, rhsExpr, overallPatTy, overallExprTy =
             match rhsExpr with
@@ -10815,7 +10828,7 @@ and TcNonRecursiveBinding declKind cenv env tpenv ty binding =
             warning(Error(FSComp.SR.tcInfoIfFunctionShadowsUnionCase(), headPatRange))
         | _ -> ()
     | _ -> ()
-
+    
     let binding = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env binding
     let explicitTyparInfo, tpenv = TcNonrecBindingTyparDecls cenv env tpenv binding
     TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([], explicitTyparInfo) binding

src/Compiler/Checking/TailCallChecks.fs

@@ -733,13 +733,8 @@ let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) =
         cenv.reportErrors
         && cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailCallAttrOnNonRec
     then
-        let isNotAFunction =
-            match bind.Var.ValReprInfo with
-            | Some info -> info.HasNoArgs
-            | _ -> false
-
         if
-            (not isRec || isNotAFunction)
+            not isRec
             && HasFSharpAttribute cenv.g cenv.g.attrib_TailCallAttribute bind.Var.Attribs
         then
             warning (Error(FSComp.SR.chkTailCallAttrOnNonRec (), bind.Var.Range))

src/Compiler/FSComp.txt

@@ -1588,6 +1588,7 @@ featureChkNotTailRecursive,"Raises warnings if a member or function has the 'Tai
 featureWhileBang,"'while!' expression"
 featureExtendedFixedBindings,"extended fixed bindings for byref and GetPinnableReference"
 featurePreferStringGetPinnableReference,"prefer String.GetPinnableReference in fixed bindings"
+featureEnforceAttributeTargetsOnLetValues,"Enforce AttributeTargets on let values"
 featurePreferExtensionMethodOverPlainProperty,"prefer extension method over plain property"
 featureWarningIndexedPropertiesGetSetSameType,"Indexed properties getter and setter must have the same type"
 featureChkTailCallAttrOnNonRec,"Raises warnings if the 'TailCall' attribute is used on non-recursive functions."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -80,6 +80,7 @@ type LanguageFeature =
     | ReuseSameFieldsInStructUnions
     | ExtendedFixedBindings
     | PreferStringGetPinnableReference
+    | EnforceAttributeTargetsOnLetValues
     | PreferExtensionMethodOverPlainProperty
     | WarningIndexedPropertiesGetSetSameType
     | WarningWhenTailCallAttrOnNonRec
@@ -189,6 +190,7 @@ type LanguageVersion(versionText) =
                 // F# preview
                 LanguageFeature.FromEndSlicing, previewVersion
                 LanguageFeature.UnmanagedConstraintCsharpInterop, previewVersion
+                LanguageFeature.EnforceAttributeTargetsOnLetValues, previewVersion
                 LanguageFeature.ReuseSameFieldsInStructUnions, previewVersion
                 LanguageFeature.PreferExtensionMethodOverPlainProperty, previewVersion
                 LanguageFeature.WarningIndexedPropertiesGetSetSameType, previewVersion
@@ -330,6 +332,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.ReuseSameFieldsInStructUnions -> FSComp.SR.featureReuseSameFieldsInStructUnions ()
         | LanguageFeature.ExtendedFixedBindings -> FSComp.SR.featureExtendedFixedBindings ()
         | LanguageFeature.PreferStringGetPinnableReference -> FSComp.SR.featurePreferStringGetPinnableReference ()
+        | LanguageFeature.EnforceAttributeTargetsOnLetValues -> FSComp.SR.featureEnforceAttributeTargetsOnLetValues ()
         | LanguageFeature.PreferExtensionMethodOverPlainProperty -> FSComp.SR.featurePreferExtensionMethodOverPlainProperty ()
         | LanguageFeature.WarningIndexedPropertiesGetSetSameType -> FSComp.SR.featureWarningIndexedPropertiesGetSetSameType ()
         | LanguageFeature.WarningWhenTailCallAttrOnNonRec -> FSComp.SR.featureChkTailCallAttrOnNonRec ()

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -70,6 +70,7 @@ type LanguageFeature =
     | ReuseSameFieldsInStructUnions
     | ExtendedFixedBindings
     | PreferStringGetPinnableReference
+    | EnforceAttributeTargetsOnLetValues
     /// RFC-1137
     | PreferExtensionMethodOverPlainProperty
     | WarningIndexedPropertiesGetSetSameType

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeTargetsIsMethod02.fs

@@ -0,0 +1,103 @@
+// #Regression #Conformance #DeclarationElements #Attributes 
+// Regression test for FSharp1.0:5172
+// Title: "method" attribute target is not recognized
+// Descr: Verify that attribute target 'method' is recognized by F# compiler correctly.
+open System
+
+[<AttributeUsage(AttributeTargets.Method)>]
+type MethodOnlyAttribute() = 
+  inherit Attribute()
+
+[<MethodOnly>]
+let someValue = "someValue" // Should fail
+
+[<MethodOnly>]
+let i, j, k = (1, 2, 3) // Should fail
+
+[<MethodOnly>]
+let someFunction () = "someFunction"
+
+[<MethodOnly>]
+let someFunction2 a = a + 1
+
+[<MethodOnly>]
+let someFunction3 (a, b) = a + b
+
+[<MethodOnly>]
+let someFunction4 (a: int) : int = a + 1
+
+[<MethodOnly>]
+let makeList a b = [ a; b ]
+
+[<MethodOnly>]
+let someTypedFunction<'a> = "someTypedFunction"
+
+[<MethodOnly>]
+let someTypedFunction2<'a> (x : 'a) = "someTypedFunction2"
+
+[<MethodOnly>]
+let someTypedFunction3 = fun x -> x
+
+[<MethodOnly>]
+let someTypedFunction4 = id
+
+[<MethodOnly>]
+let __someTypedFunction5<'a> = false
+
+[<MethodOnly>]
+let __someTypedFunction6<'a> : bool  = false
+
+[<MethodOnly>]
+let ``someValue2`` = "someValue" // Should fail
+
+type TestConst =
+    | Bool of bool
+
+[<NoComparison>]
+type TestExpr =
+    | Const of TestConst * Type * int
+    | Var of string * Type * int
+
+[<MethodOnly>]
+let (|BoolExpr|_|) =
+    function
+    | TestExpr.Const (TestConst.Bool b, _, _) -> Some b
+    | _ -> None
+
+[<MethodOnly>]
+[<return: Struct>]
+let (|BoolExpr2|_|) =
+    function
+    | TestExpr.Const(TestConst.Bool b1, _, _) -> ValueSome b1
+    | _ -> ValueNone
+
+[<MethodOnly>]
+let (|BoolExpr3|_|) x =
+    match x with
+    | TestExpr.Const (TestConst.Bool b, _, _) -> Some b
+    | _ -> None
+
+[<MethodOnly>]
+[<return: Struct>]
+let (|BoolExpr4|_|) x =
+    match x with
+    | TestExpr.Const(TestConst.Bool b1, _, _) -> ValueSome b1
+    | _ -> ValueNone
+
+let private dangling (target: TestExpr -> TestExpr voption) =
+    function
+    | TestExpr.Const (TestConst.Bool _, _, _) as b -> ValueSome b
+    | _ -> ValueNone
+
+[<MethodOnly>]
+[<return: Struct>]
+let (|IfThen|_|) =
+    dangling (function
+        | TestExpr.Const(TestConst.Bool b1, _, _) as expr -> ValueSome expr
+        | _ -> ValueNone)
+
+[<MethodOnly>]
+let someRecLetBoundValue = nameof(MethodOnlyAttribute) // Should fail
+
+[<MethodOnly>]
+let rec someRecLetBoundValue2 = nameof(someRecLetBoundValue2) // Should fail