Merge pull request #1377 from smoothdeveloper/issue-35-return-type-ab…

…stract-method-unit

Better error message when specializing generic abstract type with unit

src/fsharp/CompileOps.fs

@@ -524,6 +524,7 @@ let TypeTestUnnecessaryE() = DeclareResourceString("TypeTestUnnecessary","")
 let OverrideDoesntOverride1E() = DeclareResourceString("OverrideDoesntOverride1","%s")
 let OverrideDoesntOverride2E() = DeclareResourceString("OverrideDoesntOverride2","%s")
 let OverrideDoesntOverride3E() = DeclareResourceString("OverrideDoesntOverride3","%s")
+let OverrideDoesntOverride4E() = DeclareResourceString("OverrideDoesntOverride4","%s")
 let UnionCaseWrongArgumentsE() = DeclareResourceString("UnionCaseWrongArguments","%d%d")
 let UnionPatternsBindDifferentNamesE() = DeclareResourceString("UnionPatternsBindDifferentNames","")
 let RequiredButNotSpecifiedE() = DeclareResourceString("RequiredButNotSpecified","%s%s%s")
@@ -1144,15 +1145,32 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) =
           Printf.bprintf os "%s" msg
       | OverrideDoesntOverride(denv,impl,minfoVirtOpt,g,amap,m) ->
           let sig1 = DispatchSlotChecking.FormatOverride denv impl
-          begin match minfoVirtOpt with 
+          match minfoVirtOpt with 
           | None -> 
               os.Append(OverrideDoesntOverride1E().Format sig1) |> ignore
-          | Some minfoVirt -> 
-              os.Append(OverrideDoesntOverride2E().Format sig1) |> ignore
-              let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt
-              if sig1 <> sig2 then 
-                  os.Append(OverrideDoesntOverride3E().Format  sig2) |> ignore
-          end
+          | Some minfoVirt ->
+              // https://github.com/Microsoft/visualfsharp/issues/35 
+              // Improve error message when attempting to override generic return type with unit:
+              // we need to check if unit was used as a type argument
+              let rec hasUnitTType_app (types: TType list) =
+                  match types with
+                  | TType_app (maybeUnit, []) :: ts -> 
+                      match maybeUnit.TypeAbbrev with
+                      | Some ttype when Tastops.isUnitTy g ttype -> true
+                      | _ -> hasUnitTType_app ts
+                  | _ :: ts -> hasUnitTType_app ts
+                  | [] -> false
+
+              match minfoVirt.EnclosingType with
+              | TType_app (t, types) when t.IsFSharpInterfaceTycon && hasUnitTType_app types ->
+                  // match abstract member with 'unit' passed as generic argument
+                  os.Append(OverrideDoesntOverride4E().Format sig1) |> ignore
+              | _ -> 
+                  os.Append(OverrideDoesntOverride2E().Format sig1) |> ignore
+                  let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt
+                  if sig1 <> sig2 then 
+                      os.Append(OverrideDoesntOverride3E().Format  sig2) |> ignore
+
       | UnionCaseWrongArguments (_,n1,n2,_) ->
           os.Append(UnionCaseWrongArgumentsE().Format n2 n1) |> ignore
       | UnionPatternsBindDifferentNames _ -> 

src/fsharp/FSStrings.resx

@@ -867,6 +867,9 @@
   <data name="OverrideDoesntOverride3" xml:space="preserve">
     <value> The required signature is '{0}'.</value>
   </data>
+  <data name="OverrideDoesntOverride4" xml:space="preserve">
+    <value>The member '{0}' is specialized with 'unit' but 'unit' can't be used as return type of an abstract method parameterized on return type.</value>
+  </data>
   <data name="UnionCaseWrongArguments" xml:space="preserve">
     <value>This constructor is applied to {0} argument(s) but expects {1}</value>
   </data>

tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/UnitSpecialization.fs

@@ -0,0 +1,9 @@
+// #UnitGenericAbstractType 
+//<Expects status="success"></Expects>
+
+type Foo<'t> =
+  abstract member Bar : 't -> int
+
+type Bar() =
+  interface Foo<unit> with
+    member x.Bar _ = 1

tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/env.lst

@@ -6,3 +6,4 @@
 	SOURCE=E_LazyInType02.fs SCFLAGS="--test:ErrorRanges"		# E_LazyInType02.fs
 	SOURCE=MultipleConstraints01.fs							# MultipleConstraints01.fs
 	SOURCE=ValueTypesWithConstraints01.fs						# ValueTypesWithConstraints01.fs
+	SOURCE=UnitSpecialization.fs						# UnitSpecialization.fs

tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/E_UnitGenericAbstractType1.fs

@@ -0,0 +1,9 @@
+// #ErrorMessages #UnitGenericAbstractType 
+//<Expects status="error" span="(7,21)" id="FS0017">The member 'Apply : int -> unit' is specialized with 'unit' but 'unit' can't be used as return type of an abstract method parameterized on return type\.</Expects>
+type EDF<'S> =
+    abstract member Apply : int -> 'S
+type SomeEDF () =
+    interface EDF<unit> with
+        member this.Apply d = 
+            // [ERROR] The member 'Apply' does not have the correct type to override the corresponding abstract method.
+            ()

tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/env.lst

@@ -0,0 +1 @@
+	SOURCE=E_UnitGenericAbstractType1.fs		# E_UnitGenericAbstractType1

tests/fsharpqa/Source/test.lst

@@ -260,6 +260,7 @@ Misc01			Libraries\Core\Reflection
 Misc01			Libraries\Core\Unchecked
 Misc01			Warnings
 Misc01			ErrorMessages\NameResolution
+Misc01			ErrorMessages\UnitGenericAbstractType
 
 Misc02			Libraries\Portable
 Misc02			Misc