diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 2fb57789b81..7b4dc8d7f4f 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2356,6 +2356,8 @@ type TcConfigBuilder = mutable tryGetMetadataSnapshot : ILReaderTryGetMetadataSnapshot mutable internalTestSpanStackReferring : bool + + mutable noConditionalErasure : bool } static member Initial = @@ -2493,6 +2495,7 @@ type TcConfigBuilder = shadowCopyReferences = false tryGetMetadataSnapshot = (fun _ -> None) internalTestSpanStackReferring = false + noConditionalErasure = false } static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir, @@ -2954,6 +2957,8 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = member x.shadowCopyReferences = data.shadowCopyReferences member x.tryGetMetadataSnapshot = data.tryGetMetadataSnapshot member x.internalTestSpanStackReferring = data.internalTestSpanStackReferring + member x.noConditionalErasure = data.noConditionalErasure + static member Create(builder, validate) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter TcConfig(builder, validate) @@ -5440,9 +5445,12 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:Tc if Zset.contains qualNameOfFile tcState.tcsRootImpls then errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text), m)) + let conditionalDefines = + if tcConfig.noConditionalErasure then None else Some (tcConfig.conditionalCompilationDefines) + // Typecheck the signature file let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = - TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcState.tcsTcSigEnv file + TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcState.tcsTcSigEnv file let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs @@ -5477,9 +5485,12 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:Tc let tcImplEnv = tcState.tcsTcImplEnv + let conditionalDefines = + if tcConfig.noConditionalErasure then None else Some (tcConfig.conditionalCompilationDefines) + // Typecheck the implementation file let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = - TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcImplEnv rootSigOpt file + TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcImplEnv rootSigOpt file let hadSig = rootSigOpt.IsSome let implFileSigType = SigTypeOfImplFile implFile diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index eb371fa5927..f91873a6cf6 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -366,6 +366,9 @@ type TcConfigBuilder = /// if true - 'let mutable x = Span.Empty', the value 'x' is a stack referring span. Used for internal testing purposes only until we get true stack spans. mutable internalTestSpanStackReferring : bool + + /// Prevent erasure of conditional attributes and methods so tooling is able analyse them. + mutable noConditionalErasure: bool } static member Initial: TcConfigBuilder diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 6ae18644dea..344c0e1412a 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -848,8 +848,8 @@ let testFlag tcConfigB = | str -> warning(Error(FSComp.SR.optsUnknownArgumentToTheTestSwitch(str),rangeCmdArgs))), None, None) -// not shown in fsc.exe help, no warning on use, motivation is for use from VS -let vsSpecificFlags (tcConfigB: TcConfigBuilder) = +// Not shown in fsc.exe help, no warning on use, motivation is for use from tooling. +let editorSpecificFlags (tcConfigB: TcConfigBuilder) = [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None) CompilerOption("validate-type-providers", tagNone, OptionUnit (id), None, None) // preserved for compatibility's sake, no longer has any effect CompilerOption("LCID", tagInt, OptionInt ignore, None, None) @@ -857,7 +857,8 @@ let vsSpecificFlags (tcConfigB: TcConfigBuilder) = CompilerOption("sqmsessionguid", tagNone, OptionString ignore, None, None) CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None) CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some(s)), None, None) - CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) ] + CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) + CompilerOption("noconditionalerasure", tagNone, OptionUnit (fun () -> tcConfigB.noConditionalErasure <- true), None, None) ] let internalFlags (tcConfigB:TcConfigBuilder) = [ @@ -896,7 +897,7 @@ let internalFlags (tcConfigB:TcConfigBuilder) = CompilerOption("alwayscallvirt",tagNone,OptionSwitch(callVirtSwitch tcConfigB),Some(InternalCommandLineOption("alwayscallvirt",rangeCmdArgs)), None) CompilerOption("nodebugdata",tagNone, OptionUnit (fun () -> tcConfigB.noDebugData<-true),Some(InternalCommandLineOption("--nodebugdata",rangeCmdArgs)), None) testFlag tcConfigB ] @ - vsSpecificFlags tcConfigB @ + editorSpecificFlags tcConfigB @ [ CompilerOption("jit", tagNone, OptionSwitch (jitoptimizeSwitch tcConfigB), Some(InternalCommandLineOption("jit", rangeCmdArgs)), None) CompilerOption("localoptimize", tagNone, OptionSwitch(localoptimizeSwitch tcConfigB),Some(InternalCommandLineOption("localoptimize", rangeCmdArgs)), None) CompilerOption("splitting", tagNone, OptionSwitch(splittingSwitch tcConfigB),Some(InternalCommandLineOption("splitting", rangeCmdArgs)), None) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 495e0d4c470..ab6904c4db5 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -504,8 +504,8 @@ type cenv = /// Used to resolve names nameResolver: NameResolver - /// The set of active conditional defines - conditionalDefines: string list + /// The set of active conditional defines. The value is None when conditional erasure is disabled in tooling. + conditionalDefines: string list option isInternalTestSpanStackReferring: bool } @@ -3004,8 +3004,8 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF let conditionalCallDefineOpt = TryFindMethInfoStringAttribute cenv.g m cenv.g.attrib_ConditionalAttribute minfo - match conditionalCallDefineOpt with - | Some d when not (List.contains d cenv.conditionalDefines) -> + match conditionalCallDefineOpt, cenv.conditionalDefines with + | Some d, Some defines when not (List.contains d defines) -> // Methods marked with 'Conditional' must return 'unit' UnifyTypes cenv env m cenv.g.unit_ty (minfo.GetFSharpReturnTy(cenv.amap, m, minst)) @@ -10828,11 +10828,10 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let conditionalCallDefineOpt = TryFindTyconRefStringAttribute cenv.g mAttr cenv.g.attrib_ConditionalAttribute tcref - match conditionalCallDefineOpt with - | Some d when not (List.contains d cenv.conditionalDefines) -> + match conditionalCallDefineOpt, cenv.conditionalDefines with + | Some d, Some defines when not (List.contains d defines) -> [], false | _ -> - // REVIEW: take notice of inherited? let validOn, _inherited = let validOnDefault = 0x7fff diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 3f84e1992fc..aae09544998 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -39,14 +39,14 @@ val EmptyTopAttrs : TopAttribs val CombineTopAttrs : TopAttribs -> TopAttribs -> TopAttribs val TypeCheckOneImplFile : - TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink * bool + TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines option * NameResolution.TcResultsSink * bool -> TcEnv -> Tast.ModuleOrNamespaceType option -> ParsedImplFileInput -> Eventually val TypeCheckOneSigFile : - TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink * bool + TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines option * NameResolution.TcResultsSink * bool -> TcEnv -> ParsedSigFileInput -> Eventually diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 8b5749f0546..da2a7795577 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -100,4 +100,27 @@ module Mod2 = mod1val1.XmlDocSig |> shouldEqual "P:Mod1.val1" mod2func2.XmlDocSig |> shouldEqual "M:Mod1.Mod2.func2" - \ No newline at end of file + +module Attributes = + [] + let ``Emit conditional attributes`` () = + let source = """ +open System +open System.Diagnostics + +[] +type FooAttribute() = + inherit Attribute() + +[] +let x = 123 +""" + let fileName, options = mkTestFileAndOptions source [| "--noconditionalerasure" |] + let _, checkResults = parseAndCheckFile fileName source options + + checkResults.GetAllUsesOfAllSymbolsInFile() + |> Async.RunSynchronously + |> Array.tryFind (fun su -> su.Symbol.DisplayName = "x") + |> Option.orElseWith (fun _ -> failwith "Could not get symbol") + |> Option.map (fun su -> su.Symbol :?> FSharpMemberOrFunctionOrValue) + |> Option.iter (fun symbol -> symbol.Attributes.Count |> shouldEqual 1)