diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 4582821e486..f2d57a6ae1e 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -3799,6 +3799,7 @@ type options = dumpDebugInfo: bool referenceAssemblyOnly: bool referenceAssemblyAttribOpt: ILAttribute option + referenceAssemblySignatureHash : int option pathMap: PathMap } let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRefs) = @@ -4126,11 +4127,17 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe | HashAlgorithm.Sha256 -> System.Security.Cryptography.SHA256.Create() :> System.Security.Cryptography.HashAlgorithm let hCode = sha.ComputeHash code - let hData = sha.ComputeHash data - let hMeta = sha.ComputeHash metadata - - // Not yet suitable for the mvidsection optimization - let deterministicId = [| hCode; hData; hMeta |] |> Array.collect id |> sha.ComputeHash + let hData = sha.ComputeHash data + // Not yet suitable for the mvidsection optimization + + let deterministicId = + [| hCode + hData + match options.referenceAssemblyOnly, options.referenceAssemblySignatureHash with + | true, Some impliedSigHash -> System.BitConverter.GetBytes(impliedSigHash) + | _ -> sha.ComputeHash metadata |] + |> Array.collect id + |> sha.ComputeHash let deterministicMvid () = deterministicId[0..15] let pdbData = // Hash code, data and metadata @@ -4546,7 +4553,7 @@ let writeBinaryFiles (options: options, modul, normalizeAssemblyRefs) = let writeBinaryInMemory (options: options, modul, normalizeAssemblyRefs) = let stream = new MemoryStream() - let options = { options with referenceAssemblyOnly = false; referenceAssemblyAttribOpt = None } + let options = { options with referenceAssemblyOnly = false; referenceAssemblyAttribOpt = None; referenceAssemblySignatureHash = None } let pdbData, pdbInfoOpt, debugDirectoryChunk, debugDataChunk, debugChecksumPdbChunk, debugEmbeddedPdbChunk, debugDeterministicPdbChunk, textV2P, _mappings = writeBinaryAux(stream, options, modul, normalizeAssemblyRefs) diff --git a/src/Compiler/AbstractIL/ilwrite.fsi b/src/Compiler/AbstractIL/ilwrite.fsi index a5240473fb1..986f79d53fc 100644 --- a/src/Compiler/AbstractIL/ilwrite.fsi +++ b/src/Compiler/AbstractIL/ilwrite.fsi @@ -25,6 +25,7 @@ type options = dumpDebugInfo: bool referenceAssemblyOnly: bool referenceAssemblyAttribOpt: ILAttribute option + referenceAssemblySignatureHash: int option pathMap: PathMap } /// Write a binary to the file system. diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index f4e69616c9b..f9193b4206e 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2404,7 +2404,7 @@ module TastDefinitionPrinting = module InferredSigPrinting = open PrintTypes - + /// Layout the inferred signature of a compilation unit let layoutImpliedSignatureOfModuleOrNamespace showHeader denv infoReader ad m expr = diff --git a/src/Compiler/Checking/SignatureHash.fs b/src/Compiler/Checking/SignatureHash.fs new file mode 100644 index 00000000000..351e2f7a14a --- /dev/null +++ b/src/Compiler/Checking/SignatureHash.fs @@ -0,0 +1,528 @@ +module internal Fsharp.Compiler.SignatureHash + +open Internal.Utilities.Library +open Internal.Utilities.Rational +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.CheckDeclarations + +type ObserverVisibility = + | PublicOnly + | PublicAndInternal + +[] +module internal HashingPrimitives = + + type Hash = int + + let inline hashText (s: string) : Hash = hash s + let inline private combineHash acc y : Hash = (acc <<< 1) + y + 631 + let inline pipeToHash (value: Hash) (acc: Hash) = combineHash acc value + let inline addFullStructuralHash (value) (acc: Hash) = combineHash (acc) (hash value) + + let inline hashListOrderMatters ([] func) (items: #seq<'T>) : Hash = + let mutable acc = 0 + + for i in items do + let valHash = func i + // We are calling hashListOrderMatters for things like list of types, list of properties, list of fields etc. The ones which are visibility-hidden will return 0, and are ommited. + if valHash <> 0 then + acc <- combineHash acc valHash + + acc + + let inline hashListOrderIndependent ([] func) (items: #seq<'T>) : Hash = + let mutable acc = 0 + + for i in items do + let valHash = func i + acc <- acc ^^^ valHash + + acc + + let (@@) (h1: Hash) (h2: Hash) = combineHash h1 h2 + +[] +module internal HashUtilities = + + let private hashEntityRefName (xref: EntityRef) name = + let tag = + if xref.IsNamespace then + TextTag.Namespace + elif xref.IsModule then + TextTag.Module + elif xref.IsTypeAbbrev then + TextTag.Alias + elif xref.IsFSharpDelegateTycon then + TextTag.Delegate + elif xref.IsILEnumTycon || xref.IsFSharpEnumTycon then + TextTag.Enum + elif xref.IsStructOrEnumTycon then + TextTag.Struct + elif isInterfaceTyconRef xref then + TextTag.Interface + elif xref.IsUnionTycon then + TextTag.Union + elif xref.IsRecordTycon then + TextTag.Record + else + TextTag.Class + + (hash tag) @@ (hashText name) + + let hashTyconRefImpl (tcref: TyconRef) = + let demangled = tcref.DisplayNameWithStaticParameters + let tyconHash = hashEntityRefName tcref demangled + + tcref.CompilationPath.AccessPath + |> hashListOrderMatters (fst >> hashText) + |> pipeToHash tyconHash + +module HashIL = + + let hashILTypeRef (tref: ILTypeRef) = + tref.Enclosing + |> hashListOrderMatters hashText + |> addFullStructuralHash tref.Name + + let private hashILArrayShape (sh: ILArrayShape) = sh.Rank + + let rec hashILType (ty: ILType) : Hash = + match ty with + | ILType.Void -> hash ILType.Void + | ILType.Array (sh, t) -> hashILType t @@ hashILArrayShape sh + | ILType.Value t + | ILType.Boxed t -> hashILTypeRef t.TypeRef @@ (t.GenericArgs |> hashListOrderMatters (hashILType)) + | ILType.Ptr t + | ILType.Byref t -> hashILType t + | ILType.FunctionPointer t -> hashILCallingSignature t + | ILType.TypeVar n -> hash n + | ILType.Modified (_, _, t) -> hashILType t + + and hashILCallingSignature (signature: ILCallingSignature) = + let res = signature.ReturnType |> hashILType + signature.ArgTypes |> hashListOrderMatters (hashILType) |> pipeToHash res + +module HashAccessibility = + + let isHiddenToObserver (TAccess access) (observer: ObserverVisibility) = + let isInternalCompPath x = + match x with + | CompPath (ILScopeRef.Local, []) -> true + | _ -> false + + match access with + | [] -> false + | _ when List.forall isInternalCompPath access -> + match observer with + // The 'access' means internal, but our observer can see it (e.g. because of IVT attribute) + | PublicAndInternal -> false + | PublicOnly -> true + | _ -> true + +module rec HashTypes = + + /// Hash a reference to a type + let hashTyconRef tcref = hashTyconRefImpl tcref + + /// Hash the flags of a member + let hashMemberFlags (memFlags: SynMemberFlags) = hash memFlags + + /// Hash an attribute 'Type(arg1, ..., argN)' + let private hashAttrib (Attrib (tyconRef = tcref)) = hashTyconRefImpl tcref + + let hashAttributeList attrs = + attrs |> hashListOrderIndependent hashAttrib + + let private hashTyparRef (typar: Typar) = + hashText typar.DisplayName + |> addFullStructuralHash (typar.Rigidity) + |> addFullStructuralHash (typar.StaticReq) + + let private hashTyparRefWithInfo (typar: Typar) = + hashTyparRef typar @@ hashAttributeList typar.Attribs + + let private hashConstraint (g: TcGlobals) struct (tp, tpc) = + let tpHash = hashTyparRefWithInfo tp + + match tpc with + | TyparConstraint.CoercesTo (tgtTy, _) -> tpHash @@ 1 @@ hashTType g tgtTy + | TyparConstraint.MayResolveMember (traitInfo, _) -> tpHash @@ 2 @@ hashTraitWithInfo (* denv *) g traitInfo + | TyparConstraint.DefaultsTo (_, ty, _) -> tpHash @@ 3 @@ hashTType g ty + | TyparConstraint.IsEnum (ty, _) -> tpHash @@ 4 @@ hashTType g ty + | TyparConstraint.SupportsComparison _ -> tpHash @@ 5 + | TyparConstraint.SupportsEquality _ -> tpHash @@ 6 + | TyparConstraint.IsDelegate (aty, bty, _) -> tpHash @@ 7 @@ hashTType g aty @@ hashTType g bty + | TyparConstraint.SupportsNull _ -> tpHash @@ 8 + | TyparConstraint.IsNonNullableStruct _ -> tpHash @@ 9 + | TyparConstraint.IsUnmanaged _ -> tpHash @@ 10 + | TyparConstraint.IsReferenceType _ -> tpHash @@ 11 + | TyparConstraint.SimpleChoice (tys, _) -> tpHash @@ 12 @@ (tys |> hashListOrderIndependent (hashTType g)) + | TyparConstraint.RequiresDefaultConstructor _ -> tpHash @@ 13 + + /// Hash type parameter constraints + let private hashConstraints (g: TcGlobals) cxs = + cxs |> hashListOrderIndependent (hashConstraint g) + + let private hashTraitWithInfo (g: TcGlobals) traitInfo = + let nameHash = hashText traitInfo.MemberLogicalName + let memberHash = hashMemberFlags traitInfo.MemberFlags + + let returnTypeHash = + match traitInfo.CompiledReturnType with + | Some t -> hashTType g t + | _ -> -1 + + traitInfo.CompiledObjectAndArgumentTypes + |> hashListOrderIndependent (hashTType g) + |> pipeToHash (nameHash) + |> pipeToHash (returnTypeHash) + |> pipeToHash memberHash + + /// Hash a unit of measure expression + let private hashMeasure unt = + let measuresWithExponents = + ListMeasureVarOccsWithNonZeroExponents unt + |> List.sortBy (fun (tp: Typar, _) -> tp.DisplayName) + + measuresWithExponents + |> hashListOrderIndependent (fun (typar, exp: Rational) -> hashTyparRef typar @@ hash exp) + + /// Hash a type, taking precedence into account to insert brackets where needed + let hashTType (g: TcGlobals) ty = + + match stripTyparEqns ty |> (stripTyEqns g) with + | TType_ucase (UnionCaseRef (tc, _), args) + | TType_app (tc, args, _) -> args |> hashListOrderMatters (hashTType g) |> pipeToHash (hashTyconRef tc) + | TType_anon (anonInfo, tys) -> + tys + |> hashListOrderMatters (hashTType g) + |> pipeToHash (anonInfo.SortedNames |> hashListOrderMatters hashText) + |> addFullStructuralHash (evalAnonInfoIsStruct anonInfo) + | TType_tuple (tupInfo, t) -> + t + |> hashListOrderMatters (hashTType g) + |> addFullStructuralHash (evalTupInfoIsStruct tupInfo) + // Hash a first-class generic type. + | TType_forall (tps, tau) -> tps |> hashListOrderMatters (hashTyparRef) |> pipeToHash (hashTType g tau) + | TType_fun _ -> + let argTys, retTy = stripFunTy g ty + argTys |> hashListOrderMatters (hashTType g) |> pipeToHash (hashTType g retTy) + | TType_var (r, _) -> hashTyparRefWithInfo r + | TType_measure unt -> hashMeasure unt + + // Hash a single argument, including its name and type + let private hashArgInfo (g: TcGlobals) (ty, argInfo: ArgReprInfo) = + + let attributesHash = hashAttributeList argInfo.Attribs + + let nameHash = + match argInfo.Name with + | Some i -> hashText i.idText + | _ -> -1 + + let typeHash = hashTType g ty + + typeHash @@ nameHash @@ attributesHash + + let private hashCurriedArgInfos (g: TcGlobals) argInfos = + argInfos + |> hashListOrderMatters (fun l -> l |> hashListOrderMatters (hashArgInfo g)) + + /// Hash a single type used as the type of a member or value + let hashTopType (g: TcGlobals) argInfos retTy cxs = + let retTypeHash = hashTType g retTy + let cxsHash = hashConstraints g cxs + let argHash = hashCurriedArgInfos g argInfos + + retTypeHash @@ cxsHash @@ argHash + + let private hashTyparInclConstraints (g: TcGlobals) (typar: Typar) = + typar.Constraints + |> hashListOrderIndependent (fun tpc -> hashConstraint g (typar, tpc)) + |> pipeToHash (hashTyparRef typar) + + /// Hash type parameters + let hashTyparDecls (g: TcGlobals) (typars: Typars) = + typars |> hashListOrderMatters (hashTyparInclConstraints g) + + let private hashUncurriedSig (g: TcGlobals) typarInst argInfos retTy = + typarInst + |> hashListOrderMatters (fun (typar, ttype) -> hashTyparInclConstraints g typar @@ hashTType g ttype) + |> pipeToHash (hashTopType g argInfos retTy []) + + let private hashMemberSigCore (g: TcGlobals) memberToParentInst (typarInst, methTypars: Typars, argInfos, retTy) = + typarInst + |> hashListOrderMatters (fun (typar, ttype) -> hashTyparInclConstraints g typar @@ hashTType g ttype) + |> pipeToHash (hashTopType g argInfos retTy []) + |> pipeToHash ( + memberToParentInst + |> hashListOrderMatters (fun (typar, ty) -> hashTyparRef typar @@ hashTType g ty) + ) + |> pipeToHash (hashTyparDecls g methTypars) + + let hashMemberType (g: TcGlobals) vref typarInst argInfos retTy = + match PartitionValRefTypars g vref with + | Some (_, _, memberMethodTypars, memberToParentInst, _) -> + hashMemberSigCore g memberToParentInst (typarInst, memberMethodTypars, argInfos, retTy) + | None -> hashUncurriedSig g typarInst argInfos retTy + +module HashTastMemberOrVals = + open HashTypes + + let private hashMember (g: TcGlobals, observer) typarInst (v: Val) = + let vref = mkLocalValRef v + + if HashAccessibility.isHiddenToObserver vref.Accessibility observer then + 0 + else + let membInfo = Option.get vref.MemberInfo + let _tps, argInfos, retTy, _ = GetTypeOfMemberInFSharpForm g vref + + let memberFlagsHash = hashMemberFlags membInfo.MemberFlags + let parentTypeHash = hashTyconRef membInfo.ApparentEnclosingEntity + let memberTypeHash = hashMemberType g vref typarInst argInfos retTy + let flagsHash = hash v.val_flags.PickledBits + let nameHash = hashText v.DisplayNameCoreMangled + let attribsHash = hashAttributeList v.Attribs + + let combinedHash = + memberFlagsHash + @@ parentTypeHash @@ memberTypeHash @@ flagsHash @@ nameHash @@ attribsHash + + combinedHash + + let private hashNonMemberVal (g: TcGlobals, observer) (tps, v: Val, tau, cxs) = + if HashAccessibility.isHiddenToObserver v.Accessibility observer then + 0 + else + let valReprInfo = arityOfValForDisplay v + let nameHash = hashText v.DisplayNameCoreMangled + let typarHash = hashTyparDecls g tps + let argInfos, retTy = GetTopTauTypeInFSharpForm g valReprInfo.ArgInfos tau v.Range + let typeHash = hashTopType g argInfos retTy cxs + let flagsHash = hash v.val_flags.PickledBits + let attribsHash = hashAttributeList v.Attribs + + let combinedHash = nameHash @@ typarHash @@ typeHash @@ flagsHash @@ attribsHash + combinedHash + + let hashValOrMemberNoInst (g, obs) (vref: ValRef) = + match vref.MemberInfo with + | None -> + let tps, tau = vref.GeneralizedType + + let cxs = + tps + |> Seq.collect (fun tp -> tp.Constraints |> Seq.map (fun cx -> struct (tp, cx))) + + hashNonMemberVal (g, obs) (tps, vref.Deref, tau, cxs) + | Some _ -> hashMember (g, obs) emptyTyparInst vref.Deref + +//------------------------------------------------------------------------- + +/// Printing TAST objects +module TyconDefinitionHash = + open HashTypes + + let private hashRecdField (g: TcGlobals, observer) (fld: RecdField) = + if HashAccessibility.isHiddenToObserver fld.Accessibility observer then + 0 + else + let nameHash = hashText fld.DisplayNameCore + + let attribHash = + hashAttributeList fld.FieldAttribs @@ hashAttributeList fld.PropertyAttribs + + let typeHash = hashTType g fld.FormalType + + let combined = + nameHash + @@ attribHash + @@ typeHash @@ (hash fld.IsStatic) @@ (hash fld.IsVolatile) @@ (hash fld.IsMutable) + + combined + + let private hashUnionCase (g: TcGlobals, observer) (ucase: UnionCase) = + if HashAccessibility.isHiddenToObserver ucase.Accessibility observer then + 0 + else + let nameHash = hashText ucase.Id.idText + let attribHash = hashAttributeList ucase.Attribs + + ucase.RecdFieldsArray + |> hashListOrderMatters (fun rf -> hashRecdField (g, observer) rf) + |> pipeToHash nameHash + |> pipeToHash attribHash + + let private hashUnionCases (g, obs) ucases = + ucases + // Why order matters here? + // Union cases come with generated Tag members, on which code in higher-level project can depend -> if order of union cases changes, higher-level project has to be also recompiled. + // Correct me if I am wrong here pls. + |> hashListOrderMatters (hashUnionCase (g, obs)) + + let private hashFsharpDelegate g slotSig = + let (TSlotSig (_, _, _, _, paraml, retTy)) = slotSig + + (paraml + |> hashListOrderMatters (fun pl -> pl |> hashListOrderMatters (fun sp -> hashTType g sp.Type))) + |> pipeToHash (hashTType g (GetFSharpViewOfReturnType g retTy)) + + let private hashFsharpEnum (tycon: Tycon) = + tycon.AllFieldsArray + |> hashListOrderIndependent (fun f -> hashText f.DisplayNameCore) + + let private hashTyconDefn (g, observer) (tcref: TyconRef) = + let tycon = tcref.Deref + + if HashAccessibility.isHiddenToObserver tycon.Accessibility observer then + 0 + else + + let repr = tycon.TypeReprInfo + + let tyconHash = HashTypes.hashTyconRef tcref + let attribHash = hashAttributeList tcref.Attribs + let typarsHash = hashTyparDecls g tycon.TyparsNoRange + let topLevelDeclarationHash = tyconHash @@ attribHash @@ typarsHash + + // Interface implementation + let iimplsHash () = + tycon.ImmediateInterfacesOfFSharpTycon + |> hashListOrderIndependent (fun (ttype, _, _) -> hashTType g ttype) + + // Fields, static fields, val declarations + let fieldsHash () = + tycon.AllFieldsArray |> hashListOrderIndependent (hashRecdField (g, observer)) + + /// Properties, methods, constructors + let membersHash () = + tycon.MembersOfFSharpTyconByName + |> hashListOrderIndependent (fun kvp -> + kvp.Value + |> hashListOrderIndependent (HashTastMemberOrVals.hashValOrMemberNoInst (g, observer))) + + /// Super type or obj + let inheritsHash () = superOfTycon g tycon |> hashTType g + + let specializedHash = + match repr with + | TFSharpRecdRepr _ -> fieldsHash () + | TFSharpUnionRepr _ -> hashUnionCases (g, observer) tycon.UnionCasesArray + | TFSharpObjectRepr { + fsobjmodel_kind = TFSharpDelegate slotSig + } -> hashFsharpDelegate g slotSig + | TFSharpObjectRepr { fsobjmodel_kind = TFSharpEnum } -> hashFsharpEnum tycon + | TFSharpObjectRepr { + fsobjmodel_kind = TFSharpClass | TFSharpInterface | TFSharpStruct as tfor + } -> + iimplsHash () @@ fieldsHash () @@ membersHash () @@ inheritsHash () + |> pipeToHash ( + match tfor with + | TFSharpClass -> 1 + | TFSharpInterface -> 2 + | TFSharpStruct -> 3 + | _ -> 4 + ) + | TAsmRepr ilType -> HashIL.hashILType ilType + | TMeasureableRepr ty -> hashTType g ty + | TILObjectRepr _ -> iimplsHash () @@ fieldsHash () @@ membersHash () @@ inheritsHash () + | TNoRepr when tycon.TypeAbbrev.IsSome -> + let abbreviatedTy = tycon.TypeAbbrev.Value + hashTType g abbreviatedTy + | TNoRepr when tycon.IsFSharpException -> + match tycon.ExceptionInfo with + | TExnAbbrevRepr exnTcRef -> hashTyconRef exnTcRef + | TExnAsmRepr iLTypeRef -> HashIL.hashILTypeRef iLTypeRef + | TExnNone -> 0 + | TExnFresh _ -> fieldsHash () + +#if !NO_TYPEPROVIDERS + | TProvidedNamespaceRepr _ + | TProvidedTypeRepr _ +#endif + | TNoRepr -> iimplsHash () @@ fieldsHash () @@ membersHash () @@ inheritsHash () + + specializedHash |> pipeToHash topLevelDeclarationHash + + // Hash: module spec + + let hashTyconDefns (g, obs) (tycons: Tycon list) = + tycons + |> hashListOrderIndependent (mkLocalEntityRef >> (hashTyconDefn (g, obs))) + + let rec fullPath (mspec: ModuleOrNamespace) acc = + if mspec.IsNamespace then + match mspec.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions |> List.tryHead with + | Some next when next.IsNamespace -> fullPath next (acc @ [ next.DisplayNameCore ]) + | _ -> acc, mspec + else + acc, mspec + +let calculateHashOfImpliedSignature g observer (expr: ModuleOrNamespaceContents) = + + let rec hashModuleOrNameSpaceBinding (monb: ModuleOrNamespaceBinding) = + match monb with + | ModuleOrNamespaceBinding.Binding b when b.Var.LogicalName.StartsWith("doval@") -> 0 + | ModuleOrNamespaceBinding.Binding b -> HashTastMemberOrVals.hashValOrMemberNoInst (g, observer) (mkLocalValRef b.Var) + | ModuleOrNamespaceBinding.Module (moduleInfo, contents) -> hashSingleModuleOrNameSpaceIncludingName (moduleInfo, contents) + + and hashSingleModuleOrNamespaceContents x = + match x with + | TMDefRec (_, _opens, tycons, mbinds, _) -> + let mbindsHash = mbinds |> hashListOrderIndependent (hashModuleOrNameSpaceBinding) + + let tyconsHash = TyconDefinitionHash.hashTyconDefns (g, observer) tycons + + if mbindsHash <> 0 || tyconsHash <> 0 then + mbindsHash @@ tyconsHash + else + 0 + + | TMDefLet (bind, _) -> HashTastMemberOrVals.hashValOrMemberNoInst (g, observer) (mkLocalValRef bind.Var) + | TMDefOpens _ -> 0 (* empty hash *) + | TMDefs defs -> defs |> hashListOrderIndependent hashSingleModuleOrNamespaceContents + | TMDefDo _ -> 0 (* empty hash *) + + and hashSingleModuleOrNameSpaceIncludingName (mspec, def) = + if HashAccessibility.isHiddenToObserver mspec.Accessibility observer then + 0 + else + let outerPathHash = + mspec.CompilationPath.MangledPath |> hashListOrderMatters hashText + + let thisNameHash = hashText mspec.entity_logical_name + + let fullNameHash = outerPathHash @@ thisNameHash @@ (hash mspec.IsModule) + let contentHash = hashSingleModuleOrNamespaceContents def + + if contentHash = 0 then 0 else fullNameHash @@ contentHash + + hashSingleModuleOrNamespaceContents expr + +let calculateSignatureHashOfFiles (files: CheckedImplFile list) g observer = + use _ = + FSharp.Compiler.Diagnostics.Activity.startNoTags "calculateSignatureHashOfFiles" + + files + |> hashListOrderMatters (fun f -> calculateHashOfImpliedSignature g observer f.Contents) + +let calculateHashOfAssemblyTopAttributes (attrs: TopAttribs) (platform: ILPlatform option) = + let platformHash = + match platform with + | None -> 0 + | Some AMD64 -> 1 + | Some IA64 -> 2 + | Some ARM -> 3 + | Some ARM64 -> 4 + | Some X86 -> 5 + + HashTypes.hashAttributeList attrs.assemblyAttrs + @@ HashTypes.hashAttributeList attrs.mainMethodAttrs + @@ HashTypes.hashAttributeList attrs.netModuleAttrs @@ platformHash diff --git a/src/Compiler/Checking/SignatureHash.fsi b/src/Compiler/Checking/SignatureHash.fsi new file mode 100644 index 00000000000..90d25e8eabb --- /dev/null +++ b/src/Compiler/Checking/SignatureHash.fsi @@ -0,0 +1,16 @@ +module internal Fsharp.Compiler.SignatureHash + +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TypedTree +open FSharp.Compiler.CheckDeclarations + +type ObserverVisibility = + | PublicOnly + | PublicAndInternal + +val calculateHashOfImpliedSignature: + g: TcGlobals -> observer: ObserverVisibility -> expr: ModuleOrNamespaceContents -> int + +val calculateSignatureHashOfFiles: files: CheckedImplFile list -> g: TcGlobals -> observer: ObserverVisibility -> int +val calculateHashOfAssemblyTopAttributes: attrs: TopAttribs -> platform: ILPlatform option -> int diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index c38dd470a65..db6330e2bf9 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -220,9 +220,7 @@ let EncodeOptimizationData (tcGlobals, tcConfig: TcConfig, outfile, exportRemapp else data - [ - WriteOptimizationData(tcConfig, tcGlobals, outfile, isIncrementalBuild, ccu, optData) - ] + [ WriteOptimizationData(tcConfig, tcGlobals, outfile, isIncrementalBuild, ccu, optData) ] else [] diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index ae7742ca5f8..1810681cd25 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -878,6 +878,38 @@ let main3 optimizedImpls, EncodeOptimizationData(tcGlobals, tcConfig, outfile, exportRemapping, (generatedCcu, optimizationData), false) + let refAssemblySignatureHash = + match tcConfig.emitMetadataAssembly with + | MetadataAssemblyGeneration.None -> None + | MetadataAssemblyGeneration.ReferenceOnly + | MetadataAssemblyGeneration.ReferenceOut _ -> + let hasIvt = + TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute topAttrs.assemblyAttrs + |> Option.isSome + + let observer = + if hasIvt then + Fsharp.Compiler.SignatureHash.PublicAndInternal + else + Fsharp.Compiler.SignatureHash.PublicOnly + + let optDataHash = + optDataResources + |> List.map (fun ilResource -> + use s = ilResource.GetBytes().AsStream() + let sha256 = System.Security.Cryptography.SHA256.Create() + sha256.ComputeHash s) + |> List.sumBy hash + + try + Fsharp.Compiler.SignatureHash.calculateSignatureHashOfFiles typedImplFiles tcGlobals observer + + Fsharp.Compiler.SignatureHash.calculateHashOfAssemblyTopAttributes topAttrs tcConfig.platform + + optDataHash + |> Some + with e -> + printfn "Unexpected error when hashing implied signature, will hash the all of .NET metadata instead. Error: %O " e + None + // Pass on only the minimum information required for the next phase Args( ctok, @@ -898,7 +930,8 @@ let main3 signingInfo, metadataVersion, exiter, - ilSourceDocs + ilSourceDocs, + refAssemblySignatureHash ) /// Fourth phase of compilation. @@ -924,7 +957,8 @@ let main4 signingInfo, metadataVersion, exiter: Exiter, - ilSourceDocs)) + ilSourceDocs, + refAssemblySignatureHash)) = match tcImportsCapture with | None -> () @@ -1007,7 +1041,8 @@ let main4 ilxMainModule, signingInfo, exiter, - ilSourceDocs + ilSourceDocs, + refAssemblySignatureHash ) /// Fifth phase of compilation. @@ -1024,7 +1059,8 @@ let main5 ilxMainModule, signingInfo, exiter: Exiter, - ilSourceDocs)) + ilSourceDocs, + refAssemblySignatureHash)) = use _ = UseBuildPhase BuildPhase.Output @@ -1040,7 +1076,20 @@ let main5 AbortOnError(diagnosticsLogger, exiter) // Pass on only the minimum information required for the next phase - Args(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, ilxMainModule, outfile, pdbfile, signingInfo, exiter, ilSourceDocs) + Args( + ctok, + tcConfig, + tcImports, + tcGlobals, + diagnosticsLogger, + ilxMainModule, + outfile, + pdbfile, + signingInfo, + exiter, + ilSourceDocs, + refAssemblySignatureHash + ) /// Sixth phase of compilation. /// - write the binaries @@ -1056,7 +1105,8 @@ let main6 pdbfile, signingInfo, exiter: Exiter, - ilSourceDocs)) + ilSourceDocs, + refAssemblySignatureHash)) = ReportTime tcConfig "Write .NET Binary" @@ -1111,6 +1161,7 @@ let main6 dumpDebugInfo = tcConfig.dumpDebugInfo referenceAssemblyOnly = true referenceAssemblyAttribOpt = referenceAssemblyAttribOpt + referenceAssemblySignatureHash = refAssemblySignatureHash pathMap = tcConfig.pathMap }, ilxMainModule, @@ -1141,6 +1192,7 @@ let main6 dumpDebugInfo = tcConfig.dumpDebugInfo referenceAssemblyOnly = false referenceAssemblyAttribOpt = None + referenceAssemblySignatureHash = None pathMap = tcConfig.pathMap }, ilxMainModule, diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 4e061b6724d..2ebec6942dd 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -351,6 +351,8 @@ + + diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 4457ac3142d..d1d541816bf 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1852,6 +1852,7 @@ type internal FsiDynamicCompiler dumpDebugInfo = tcConfig.dumpDebugInfo referenceAssemblyOnly = false referenceAssemblyAttribOpt = None + referenceAssemblySignatureHash = None pathMap = tcConfig.pathMap } diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 311b5a82f66..73d75f5713d 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2955,6 +2955,16 @@ type FSharpCheckFileResults |> LayoutRender.showL |> SourceText.ofString) + member internal _.CalculateSignatureHash() = + let visibility = Fsharp.Compiler.SignatureHash.PublicAndInternal + + match details with + | None -> failwith "Typechecked details not available for CalculateSignatureHash() operation." + | Some (scope, _builderOpt) -> + scope.ImplementationFile + |> Option.map (fun implFile -> + Fsharp.Compiler.SignatureHash.calculateSignatureHashOfFiles [ implFile ] scope.TcGlobals visibility) + member _.ImplementationFile = if not keepAssemblyContents then invalidOp diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 81d50d90b78..fa8bb607267 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -428,6 +428,8 @@ type public FSharpCheckFileResults = /// Lays out and returns the formatted signature for the typechecked file as source text. member GenerateSignature: ?pageWidth: int -> ISourceText option + member internal CalculateSignatureHash: unit -> int option + /// Internal constructor static member internal MakeEmpty: fileName: string * creationErrors: FSharpDiagnostic[] * keepAssemblyContents: bool -> FSharpCheckFileResults diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Platform/Platform.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Platform/Platform.fs index 6a914c234ed..20fbc933dba 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Platform/Platform.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Platform/Platform.fs @@ -146,12 +146,14 @@ module Platform = let assemblyHasMvidSection = FsFromPath (Path.Combine(__SOURCE_DIRECTORY__, "SimpleFsProgram.fs")) |> asLibrary + |> withOptions ["--test:DumpSignatureData"] |> withRefOnly compilation |> asExe |> withReferences [mvidReader] |> withReferences [assemblyHasMvidSection] + |> withOptions ["--test:DumpSignatureData"] |> compileExeAndRun |> shouldSucceed diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index c99458dabbf..abaeb77e799 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -250,6 +250,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/ImpliedSignatureHashTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/ImpliedSignatureHashTests.fs new file mode 100644 index 00000000000..a7ee96305ad --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/ImpliedSignatureHashTests.fs @@ -0,0 +1,299 @@ +module FSharp.Compiler.ComponentTests.Signatures.ImpliedSignatureHashTests + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + + + +[] + +[] + +[] + +[] + +[] + +[ }""")>] + +[] + +[] + + +[] + +[] + +[] + +[] + +[] + + +[] + +[] + +[] + +[""" +(*AFTER*),"""module MyTest +let foo () = <@ 2 + 3 @>""")>] + +[] + +[ int) and 'a:(static member One: unit -> int)> () = 'a.Zero() + 'a.One()""" +(*AFTER*),"""module MyTest +let inline mySRTPFunc<'a when 'a:(static member One: unit -> int) and 'a:(static member Zero: unit -> int)> () = 'a.Zero() + 'a.One()""")>] + +[] + +[] + [] + type C = + [] + val mutable private goo : byte [] + member this.P with set(x) = this.goo <- x """ +(*AFTER*),"""module StructPrivateField = + [] + [] + type C = + [] + val mutable private boo : byte [] + member this.P with set(x) = this.boo <- x """)>] + +let ``Hash should be stable for`` (change:string,codeBefore:string,codeAfter:string) = + let hashBefore = Fs codeBefore |> getImpliedSignatureHash + let hashAfter = Fs codeAfter |> getImpliedSignatureHash + + + Assert.True((hashBefore = hashAfter), userMessage = change.ToString()) + + + + +[] + +[] + +[] + +[] +let A = "A" """)>] + +[] +type MyRecord = {X:string} """)>] + +[] + +[ int)> () = 'a.Zero() + 'a.Zero()""" +(*AFTER*),"""module MyTest +let inline mySRTPFunc<'a when 'a:(static member One: unit -> int) and 'a:(static member Zero: unit -> int)> () = 'a.Zero() + 'a.One()""")>] + +[ int)> () = 'a.Zero() + 'a.Zero()""" +(*AFTER*),"""module MyTest +let inline mySRTPFunc<'a when 'a:(static member One: unit -> int)> () = 'a.One() + 'a.One()""")>] + +[ int)> () = 'a.Zero() + 'a.Zero()""" +(*AFTER*),"""module MyTest +let inline mySRTPFunc<'a when 'a:(static member Zero: unit -> byte)> () = 'a.Zero() + 'a.Zero()""")>] + +[""" +(*AFTER*),"""module MyTest +let foo () = <@ false @>""")>] + +[] + +[] +type MyDU = + | A + | B """)>] + +[ + (x: 'b) + (y: 'a) + = printfn "%A %A" x y """ +(*AFTER*),"""module MyTest +let f<'b, 'a> + (x: 'b) + (y: 'a) + = printfn "%A %A" x y """)>] + +[] c: int) : int = 0 """)>] + +//TODO add a lot more negative tests - in which cases should hash in fact change + +[] +let ``Hash should change when`` (change:string,codeBefore:string,codeAfter:string) = + let hashBefore = Fs codeBefore |> getImpliedSignatureHash + let hashAfter = Fs codeAfter |> getImpliedSignatureHash + + + Assert.False((hashBefore = hashAfter), userMessage = change.ToString()) \ No newline at end of file diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index caa56ba97e5..0ce5b995ad2 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -1696,3 +1696,13 @@ module rec Compiler = let printSignatures cUnit = printSignaturesImpl None cUnit let printSignaturesWith pageWidth cUnit = printSignaturesImpl (Some pageWidth) cUnit + + + let getImpliedSignatureHash cUnit = + let tcResults = cUnit |> typecheckResults + let hash = tcResults.CalculateSignatureHash() + match hash with + | Some h -> h + | None -> failwith "Implied signature hash returned 'None' which should not happen" + + \ No newline at end of file diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs index 1d714c38c59..6900827bb9b 100644 --- a/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs @@ -7,373 +7,138 @@ open FSharp.Test open FSharp.Test.Compiler open NUnit.Framework + [] module DeterministicTests = - [] - let ``Simple assembly should be deterministic``() = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module Assembly - -open System - -let test() = - Console.WriteLine("Hello World!") - """ - - let mvid1 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--deterministic"] - |> compileGuid - let mvid2 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--deterministic"] - |> compileGuid - - // Two identical compilations should produce the same MVID - Assert.AreEqual(mvid1, mvid2) - - [] - let ``Simple assembly with different platform should not be deterministic``() = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module Assembly + let commonOptions = ["--refonly";"--deterministic";"--nooptimizationdata"] + let inputPath = CompilerAssert.GenerateFsInputPath() + let outputPath = CompilerAssert.GenerateDllOutputPath() -open System - -let test() = - Console.WriteLine("Hello World!") - """ - - let mvid1 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--deterministic"] - |> compileGuid - let mvid2 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--deterministic";"--platform:Itanium"] - |> compileGuid - - // No two platforms should produce the same MVID - Assert.AreNotEqual(mvid1, mvid2) + [] + let ivtSnippet = """ +[] +do() +""" - [] - let ``Simple reference assembly should be deterministic``() = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ + [] + let basicCodeSnippet = """ module ReferenceAssembly open System -let private privTest() = - Console.WriteLine("Private Hello World!") - -let test() = - privTest() - Console.WriteLine("Hello World!") - """ - - let mvid1 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - let mvid2 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two identical compilations should produce the same MVID - Assert.AreEqual(mvid1, mvid2) - - [] - let ``Simple reference assembly with different platform should not be deterministic``() = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module ReferenceAssembly - -open System +//PLACEHOLDER let private privTest() = Console.WriteLine("Private Hello World!") let test() = privTest() - Console.WriteLine("Hello World!") - """ - - let mvid1 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - let mvid2 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic";"--platform:Itanium"] - |> compileGuid - - // No two platforms should produce the same MVID - Assert.AreNotEqual(mvid1, mvid2) - + Console.WriteLine("Hello World!")""" - [] - let ``False-positive reference assemblies test, different aseemblies' mvid should not match`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module ReferenceAssembly -open System - -let test() = - Console.WriteLine("Hello World!") - """ + let getMvid codeSnippet compileOptions = + File.WriteAllText(inputPath, codeSnippet) let mvid1 = - FSharpWithInputAndOutputPath src inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] + FSharpWithInputAndOutputPath codeSnippet inputPath outputPath + |> withOptions compileOptions |> compileGuid + mvid1 - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() - let src2 = - """ -module ReferenceAssembly - -open System - -let test2() = - Console.WriteLine("Hello World!") - """ - - let mvid2 = - FSharpWithInputAndOutputPath src2 inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid + let commonOptionsBasicMvid = lazy(getMvid basicCodeSnippet commonOptions) - // Two different compilations should _not_ produce the same MVID - Assert.AreNotEqual(mvid1, mvid2) -(* - [] - let ``Reference assemblies should be deterministic when only private function name is different with the same function name length`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module ReferenceAssembly + let calculateRefAssMvids referenceCodeSnippet codeAfterChangeIsDone = -open System + let mvid1 = + if referenceCodeSnippet = basicCodeSnippet then + commonOptionsBasicMvid.Value + else + getMvid referenceCodeSnippet commonOptions -let private privTest1() = - Console.WriteLine("Private Hello World!") + let mvid2 = getMvid codeAfterChangeIsDone commonOptions + mvid1 , mvid2 -let test() = - privTest1() - Console.WriteLine("Hello World!") - """ - File.WriteAllText(inputFilePath, src) + [] + let ``Simple assembly should be deterministic``() = + File.WriteAllText(inputPath, basicCodeSnippet) - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] + let getMvid() = + FSharpWithInputAndOutputPath basicCodeSnippet inputPath outputPath + |> withOptions ["--deterministic"] |> compileGuid + // Two identical compilations should produce the same MVID + Assert.AreEqual(getMvid(), getMvid()) - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() - let src2 = - """ -module ReferenceAssembly - -open System + [] + let ``Simple assembly with different platform should not be deterministic``() = + let mvid1 = getMvid basicCodeSnippet ["--deterministic"] + let mvid2 = getMvid basicCodeSnippet ["--deterministic";"--platform:Itanium"] + // No two platforms should produce the same MVID + Assert.AreNotEqual(mvid1, mvid2) -let private privTest2() = - Console.WriteLine("Private Hello World!") + [] + let ``Simple reference assembly should be deterministic``() = + let mvid1, mvid2 = calculateRefAssMvids basicCodeSnippet basicCodeSnippet + Assert.AreEqual(mvid1, mvid2) -let test() = - privTest2() - Console.WriteLine("Hello World!") - """ + [] + let ``Simple reference assembly with different platform should not be deterministic``() = + let mvid1 = getMvid basicCodeSnippet ["--refonly";"--deterministic"] + let mvid2 = getMvid basicCodeSnippet ["--refonly";"--deterministic";"--platform:Itanium"] - File.WriteAllText(inputFilePath2, src2) + // No two platforms should produce the same MVID + Assert.AreNotEqual(mvid1, mvid2) - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid + [] + let ``False-positive reference assemblies test, different aseemblies' mvid should not match`` () = + let src2 = basicCodeSnippet.Replace("test()","test2()") + let mvid1, mvid2 = calculateRefAssMvids basicCodeSnippet src2 + Assert.AreNotEqual(mvid1, mvid2) - // Two compilations with changes only to private code should produce the same MVID + [] + let ``Reference assemblies should be deterministic when only private function name is different with the same function name length`` () = + let privCode1 = basicCodeSnippet.Replace("privTest()","privTest1()") + let privCode2 = basicCodeSnippet.Replace("privTest()","privTest2()") + let mvid1, mvid2 = calculateRefAssMvids privCode1 privCode2 Assert.AreEqual(mvid1, mvid2) - [] + [] let ``Reference assemblies should be deterministic when only private function name is different with the different function name length`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module ReferenceAssembly - -open System - -let private privTest1() = - Console.WriteLine("Private Hello World!") - -let test() = - privTest1() - Console.WriteLine("Hello World!") - """ - - File.WriteAllText(inputFilePath, src) - - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() - let src2 = - """ -module ReferenceAssembly - -open System - -let private privTest11() = - Console.WriteLine("Private Hello World!") - -let test() = - privTest11() - Console.WriteLine("Hello World!") - """ - - File.WriteAllText(inputFilePath2, src2) - - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two compilations with changes only to private code should produce the same MVID + let src2 = basicCodeSnippet.Replace("privTest()","privTest11()") + let mvid1, mvid2 = calculateRefAssMvids basicCodeSnippet src2 Assert.AreEqual(mvid1, mvid2) - [] + [] let ``Reference assemblies should be deterministic when only private function body is different`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module ReferenceAssembly - -open System - -let private privTest1() = - Console.WriteLine("Private Hello World!") - -let test() = - privTest1() - Console.WriteLine("Hello World!") - """ - - File.WriteAllText(inputFilePath, src) - - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() - let src2 = - """ -module ReferenceAssembly - -open System - -let private privTest1() = - Console.Write("Private Hello World!") - -let test() = - privTest1() - Console.WriteLine("Hello World!") - """ - - File.WriteAllText(inputFilePath2, src2) - - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two compilations with changes only to private code should produce the same MVID + let src2 = basicCodeSnippet.Replace("""Console.WriteLine("Private Hello World!")""","""Console.Write("Private Hello World!")""") + let mvid1, mvid2 = calculateRefAssMvids basicCodeSnippet src2 Assert.AreEqual(mvid1, mvid2) - [] + [] let ``Reference assemblies should be deterministic when only private function return type is different`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let src = - """ -module ReferenceAssembly - -open System - -let private privTest1() : string = "Private Hello World!" -let test() = - privTest1() |> ignore - Console.WriteLine() - """ - - File.WriteAllText(inputFilePath, src) - - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() let src2 = """ module ReferenceAssembly open System -let private privTest1() : int = 0 +let private privTest() : int = 0 let test() = - privTest1() |> ignore + privTest() |> ignore Console.WriteLine() """ - - File.WriteAllText(inputFilePath2, src2) - - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two compilations with changes only to private code should produce the same MVID + let mvid1, mvid2 = calculateRefAssMvids basicCodeSnippet src2 Assert.AreEqual(mvid1, mvid2) - [] + [] let ``Reference assemblies should be deterministic when only private function parameter count is different`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() let src = """ module ReferenceAssembly @@ -386,17 +151,7 @@ let test() = privTest1 () |> ignore Console.WriteLine() """ - - File.WriteAllText(inputFilePath, src) - - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() + let src2 = """ module ReferenceAssembly @@ -410,21 +165,11 @@ let test() = Console.WriteLine() """ - File.WriteAllText(inputFilePath2, src2) - - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two compilations with changes only to private code should produce the same MVID + let mvid1, mvid2 = calculateRefAssMvids src src2 Assert.AreEqual(mvid1, mvid2) - - [] + [] let ``Reference assemblies should be deterministic when only private function parameter count is different and private function is unused`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() let src = """ module ReferenceAssembly @@ -436,17 +181,6 @@ let private privTest1 () : string = "Private Hello World!" let test() = Console.WriteLine() """ - - File.WriteAllText(inputFilePath, src) - - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() let src2 = """ module ReferenceAssembly @@ -459,20 +193,11 @@ let test() = Console.WriteLine() """ - File.WriteAllText(inputFilePath2, src2) - - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two compilations with changes only to private code should produce the same MVID + let mvid1, mvid2 = calculateRefAssMvids src src2 Assert.AreEqual(mvid1, mvid2) - [] + [] let ``Reference assemblies should be deterministic when only private function parameter types are different`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() let src = """ module ReferenceAssembly @@ -486,16 +211,6 @@ let test() = Console.WriteLine() """ - File.WriteAllText(inputFilePath, src) - - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() let src2 = """ module ReferenceAssembly @@ -508,21 +223,12 @@ let test() = privTest1 "" |> ignore Console.WriteLine() """ - - File.WriteAllText(inputFilePath2, src2) - - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid - - // Two compilations with changes only to private code should produce the same MVID + + let mvid1, mvid2 = calculateRefAssMvids src src2 Assert.AreEqual(mvid1, mvid2) - [] + [] let ``Reference assemblies should be deterministic when private function is missing in one of them`` () = - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() let src = """ module ReferenceAssembly @@ -536,16 +242,35 @@ let test() = Console.WriteLine() """ - File.WriteAllText(inputFilePath, src) + let src2 = + """ +module ReferenceAssembly - let mvid1 = - FSharpWithInputAndOutputPath inputFilePath outputFilePath - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid +open System +let test() = + Console.WriteLine() + """ + + let mvid1, mvid2 = calculateRefAssMvids src src2 + Assert.AreEqual(mvid1, mvid2) + + [] + let ``Reference assemblies should be deterministic when inner function is removed`` () = + let src = + """ +module ReferenceAssembly + +open System - let inputFilePath2 = CompilerAssert.GenerateFsInputPath() - let outputFilePath2 = CompilerAssert.GenerateDllOutputPath() +let test() = + let innerFunc number = + string number + + let stringVal = innerFunc 15 + Console.WriteLine(stringVal) + """ + let src2 = """ module ReferenceAssembly @@ -555,16 +280,57 @@ open System let test() = Console.WriteLine() """ + + let mvid1, mvid2 = calculateRefAssMvids src src2 + Assert.AreEqual(mvid1, mvid2) - File.WriteAllText(inputFilePath2, src2) + [] + let ``Reference assemblies should be same when contents of quoted expression change`` () = + let src = + """ +module ReferenceAssembly - let mvid2 = - FSharpWithInputAndOutputPath inputFilePath2 outputFilePath2 - |> withOptions ["--refonly";"--deterministic"] - |> compileGuid +let foo () = <@ 2 + 2 @> + """ + + let src2 = + """ +module ReferenceAssembly + +let foo () = <@ 2 + 3 @> + """ - // Two compilations with changes only to private code should produce the same MVID + let mvid1, mvid2 = calculateRefAssMvids src src2 Assert.AreEqual(mvid1, mvid2) - // TODO: Add tests for Internal types (+IVT), (private, internal, public) fields, properties, events. -*) \ No newline at end of file + [] + let ``Reference assemblies must change when a must-inline function changes body`` () = + let codeBefore = """module ReferenceAssembly +let inline myFunc x y = x + y""" + let codeAfter = codeBefore.Replace("+","-") + let mvid1, mvid2 = calculateRefAssMvids codeBefore codeAfter + Assert.AreNotEqual(mvid1,mvid2) + + [] + let ``Reference assemblies must not change when a must-inline function does not change`` () = + let codeBefore = """module ReferenceAssembly +let inline myFunc x y = x - y""" + let mvid1, mvid2 = calculateRefAssMvids codeBefore codeBefore + Assert.AreEqual(mvid1,mvid2) + + + [] // If IVT provided -> MVID must reflect internal binding + [] // No IVT => internal binding can be ignored for mvid purposes + let ``Reference assemblies MVID when having internal binding``(additionalSnippet:string, shouldBeStable:bool) = + let codeAfter = + basicCodeSnippet + .Replace("private","internal") + .Replace("//PLACEHOLDER", additionalSnippet) + + let mvid1, mvid2 = calculateRefAssMvids basicCodeSnippet codeAfter + + if shouldBeStable then + Assert.AreEqual(mvid1,mvid2) + else + Assert.AreNotEqual(mvid1,mvid2) +