Skip to content

Commit 97ffb68

Browse files
Smaug123Smaug123
committed
Speculative commit to restore range information where required
1 parent b15bd8b commit 97ffb68

2 files changed

Lines changed: 86 additions & 66 deletions

File tree

‎src/Compiler/Checking/FindUnsolved.fs‎

Lines changed: 68 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -28,15 +28,20 @@ type cenv =
2828

2929
override _.ToString() = "<cenv>"
3030

31-
/// Walk types, collecting type variables
32-
let accTy cenv _env ty =
31+
/// Walk types, collecting type variables.
32+
/// The backupRange is attached best-effort to unsolved type parameters, for better reporting.
33+
let accTy cenv _env (backupRange: Text.range) ty =
3334
let normalizedTy = tryNormalizeMeasureInType cenv.g ty
3435
(freeInType CollectTyparsNoCaching normalizedTy).FreeTypars |> Zset.iter (fun tp ->
35-
if (tp.Rigidity <> TyparRigidity.Rigid) then
36-
cenv.unsolved <- tp :: cenv.unsolved)
36+
if (tp.Rigidity <> TyparRigidity.Rigid) then
37+
let tp =
38+
if tp.Range = Text.Range.range0 then
39+
{ tp with typar_id = Syntax.Ident(tp.typar_id.idText, backupRange) }
40+
else tp
41+
cenv.unsolved <- tp :: cenv.unsolved)
3742

38-
let accTypeInst cenv env tyargs =
39-
tyargs |> List.iter (accTy cenv env)
43+
let accTypeInst cenv env (backupRange: Text.range) tyargs =
44+
tyargs |> List.iter (accTy cenv env backupRange)
4045

4146
/// Walk expressions, collecting type variables
4247
let rec accExpr (cenv: cenv) (env: env) expr =
@@ -52,34 +57,34 @@ let rec accExpr (cenv: cenv) (env: env) expr =
5257
accBind cenv env bind
5358
accExpr cenv env body
5459

55-
| Expr.Const (_, _, ty) ->
56-
accTy cenv env ty
60+
| Expr.Const (_, m, ty) ->
61+
accTy cenv env m ty
5762

5863
| Expr.Val (_v, _vFlags, _m) -> ()
5964

60-
| Expr.Quote (ast, _, _, _m, ty) ->
65+
| Expr.Quote (ast, _, _, m, ty) ->
6166
accExpr cenv env ast
62-
accTy cenv env ty
67+
accTy cenv env m ty
6368

64-
| Expr.Obj (_, ty, basev, basecall, overrides, iimpls, _m) ->
65-
accTy cenv env ty
69+
| Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) ->
70+
accTy cenv env m ty
6671
accExpr cenv env basecall
6772
accMethods cenv env basev overrides
68-
accIntfImpls cenv env basev iimpls
73+
accIntfImpls cenv env basev m iimpls
6974

70-
| LinearOpExpr (_op, tyargs, argsHead, argLast, _m) ->
75+
| LinearOpExpr (_op, tyargs, argsHead, argLast, m) ->
7176
// Note, LinearOpExpr doesn't include any of the "special" cases for accOp
72-
accTypeInst cenv env tyargs
77+
accTypeInst cenv env m tyargs
7378
accExprs cenv env argsHead
7479
// tailcall
7580
accExpr cenv env argLast
7681

7782
| Expr.Op (c, tyargs, args, m) ->
7883
accOp cenv env (c, tyargs, args, m)
7984

80-
| Expr.App (f, fty, tyargs, argsl, _m) ->
81-
accTy cenv env fty
82-
accTypeInst cenv env tyargs
85+
| Expr.App (f, fty, tyargs, argsl, m) ->
86+
accTy cenv env m fty
87+
accTypeInst cenv env m tyargs
8388
accExpr cenv env f
8489
accExprs cenv env argsl
8590

@@ -88,36 +93,36 @@ let rec accExpr (cenv: cenv) (env: env) expr =
8893
let ty = mkMultiLambdaTy cenv.g m argvs bodyTy
8994
accLambdas cenv env valReprInfo expr ty
9095

91-
| Expr.TyLambda (_, tps, _body, _m, bodyTy) ->
96+
| Expr.TyLambda (_, tps, _body, m, bodyTy) ->
9297
let valReprInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal)
93-
accTy cenv env bodyTy
98+
accTy cenv env m bodyTy
9499
let ty = mkForallTyIfNeeded tps bodyTy
95100
accLambdas cenv env valReprInfo expr ty
96101

97102
| Expr.TyChoose (_tps, e1, _m) ->
98103
accExpr cenv env e1
99104

100105
| Expr.Match (_, _exprm, dtree, targets, m, ty) ->
101-
accTy cenv env ty
106+
accTy cenv env m ty
102107
accDTree cenv env dtree
103108
accTargets cenv env m ty targets
104109

105110
| Expr.LetRec (binds, e, _m, _) ->
106111
accBinds cenv env binds
107112
accExpr cenv env e
108113

109-
| Expr.StaticOptimization (constraints, e2, e3, _m) ->
114+
| Expr.StaticOptimization (constraints, e2, e3, m) ->
110115
accExpr cenv env e2
111116
accExpr cenv env e3
112117
constraints |> List.iter (function
113118
| TTyconEqualsTycon(ty1, ty2) ->
114-
accTy cenv env ty1
115-
accTy cenv env ty2
119+
accTy cenv env m ty1
120+
accTy cenv env m ty2
116121
| TTyconIsStruct(ty1) ->
117-
accTy cenv env ty1)
122+
accTy cenv env m ty1)
118123

119-
| Expr.WitnessArg (traitInfo, _m) ->
120-
accTraitInfo cenv env traitInfo
124+
| Expr.WitnessArg (traitInfo, m) ->
125+
accTraitInfo cenv env m traitInfo
121126

122127
| Expr.Link eref ->
123128
accExpr cenv env eref.Value
@@ -128,49 +133,49 @@ let rec accExpr (cenv: cenv) (env: env) expr =
128133
and accMethods cenv env baseValOpt l =
129134
List.iter (accMethod cenv env baseValOpt) l
130135

131-
and accMethod cenv env _baseValOpt (TObjExprMethod(_slotsig, _attribs, _tps, vs, bodyExpr, _m)) =
132-
vs |> List.iterSquared (accVal cenv env)
136+
and accMethod cenv env _baseValOpt (TObjExprMethod(_slotsig, _attribs, _tps, vs, bodyExpr, m)) =
137+
vs |> List.iterSquared (accVal cenv env m)
133138
accExpr cenv env bodyExpr
134139

135-
and accIntfImpls cenv env baseValOpt l =
136-
List.iter (accIntfImpl cenv env baseValOpt) l
140+
and accIntfImpls cenv env baseValOpt (backupRange: Text.range) l =
141+
List.iter (accIntfImpl cenv env baseValOpt backupRange) l
137142

138-
and accIntfImpl cenv env baseValOpt (ty, overrides) =
139-
accTy cenv env ty
143+
and accIntfImpl cenv env baseValOpt (backupRange: Text.range) (ty, overrides) =
144+
accTy cenv env backupRange ty
140145
accMethods cenv env baseValOpt overrides
141146

142-
and accOp cenv env (op, tyargs, args, _m) =
147+
and accOp cenv env (op, tyargs, args, m) =
143148
// Special cases
144-
accTypeInst cenv env tyargs
149+
accTypeInst cenv env m tyargs
145150
accExprs cenv env args
146151
match op with
147152
// Handle these as special cases since mutables are allowed inside their bodies
148153
| TOp.ILCall (_, _, _, _, _, _, _, _, enclTypeInst, methInst, retTys) ->
149-
accTypeInst cenv env enclTypeInst
150-
accTypeInst cenv env methInst
151-
accTypeInst cenv env retTys
154+
accTypeInst cenv env m enclTypeInst
155+
accTypeInst cenv env m methInst
156+
accTypeInst cenv env m retTys
152157
| TOp.TraitCall traitInfo ->
153-
accTraitInfo cenv env traitInfo
158+
accTraitInfo cenv env m traitInfo
154159

155160
| TOp.ILAsm (_, retTys) ->
156-
accTypeInst cenv env retTys
161+
accTypeInst cenv env m retTys
157162
| _ -> ()
158163

159-
and accTraitInfo cenv env (TTrait(tys, _nm, _, argTys, retTy, _sln)) =
160-
argTys |> accTypeInst cenv env
161-
retTy |> Option.iter (accTy cenv env)
162-
tys |> List.iter (accTy cenv env)
164+
and accTraitInfo cenv env (backupRange : Text.range) (TTrait(tys, _nm, _, argTys, retTy, _sln)) =
165+
argTys |> accTypeInst cenv env backupRange
166+
retTy |> Option.iter (accTy cenv env backupRange)
167+
tys |> List.iter (accTy cenv env backupRange)
163168

164169
and accLambdas cenv env valReprInfo expr exprTy =
165170
match stripDebugPoints expr with
166171
| Expr.TyChoose (_tps, bodyExpr, _m) -> accLambdas cenv env valReprInfo bodyExpr exprTy
167-
| Expr.Lambda _
168-
| Expr.TyLambda _ ->
172+
| Expr.Lambda (_, _, _, _, _, m, _)
173+
| Expr.TyLambda (_, _, _, m, _) ->
169174
let _tps, ctorThisValOpt, baseValOpt, vsl, body, bodyTy = destTopLambda cenv.g cenv.amap valReprInfo (expr, exprTy)
170-
accTy cenv env bodyTy
171-
vsl |> List.iterSquared (accVal cenv env)
172-
baseValOpt |> Option.iter (accVal cenv env)
173-
ctorThisValOpt |> Option.iter (accVal cenv env)
175+
accTy cenv env expr.Range bodyTy
176+
vsl |> List.iterSquared (accVal cenv env m)
177+
baseValOpt |> Option.iter (accVal cenv env m)
178+
ctorThisValOpt |> Option.iter (accVal cenv env m)
174179
accExpr cenv env body
175180
| _ ->
176181
accExpr cenv env expr
@@ -190,31 +195,31 @@ and accDTree cenv env dtree =
190195
| TDBind(bind, rest) -> accBind cenv env bind; accDTree cenv env rest
191196
| TDSwitch (e, cases, dflt, m) -> accSwitch cenv env (e, cases, dflt, m)
192197

193-
and accSwitch cenv env (e, cases, dflt, _m) =
198+
and accSwitch cenv env (e, cases, dflt, m) =
194199
accExpr cenv env e
195-
cases |> List.iter (fun (TCase(discrim, e)) -> accDiscrim cenv env discrim; accDTree cenv env e)
200+
cases |> List.iter (fun (TCase(discrim, e)) -> accDiscrim cenv env m discrim; accDTree cenv env e)
196201
dflt |> Option.iter (accDTree cenv env)
197202

198-
and accDiscrim cenv env d =
203+
and accDiscrim cenv env backupRange d =
199204
match d with
200-
| DecisionTreeTest.UnionCase(_ucref, tinst) -> accTypeInst cenv env tinst
201-
| DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env ty
205+
| DecisionTreeTest.UnionCase(_ucref, tinst) -> accTypeInst cenv env backupRange tinst
206+
| DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env backupRange ty
202207
| DecisionTreeTest.Const _
203208
| DecisionTreeTest.IsNull -> ()
204-
| DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env srcTy; accTy cenv env tgtTy
209+
| DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env backupRange srcTy; accTy cenv env backupRange tgtTy
205210
| DecisionTreeTest.ActivePatternCase (exp, tys, _, _, _, _) ->
206211
accExpr cenv env exp
207-
accTypeInst cenv env tys
212+
accTypeInst cenv env exp.Range tys
208213
| DecisionTreeTest.Error _ -> ()
209214

210-
and accAttrib cenv env (Attrib(_, _k, args, props, _, _, _m)) =
215+
and accAttrib cenv env (Attrib(_, _k, args, props, _, _, m)) =
211216
args |> List.iter (fun (AttribExpr(expr1, expr2)) ->
212217
accExpr cenv env expr1
213218
accExpr cenv env expr2)
214219
props |> List.iter (fun (AttribNamedArg(_nm, ty, _flg, AttribExpr(expr, expr2))) ->
215220
accExpr cenv env expr
216221
accExpr cenv env expr2
217-
accTy cenv env ty)
222+
accTy cenv env m ty)
218223

219224
and accAttribs cenv env attribs =
220225
List.iter (accAttrib cenv env) attribs
@@ -226,13 +231,13 @@ and accValReprInfo cenv env (ValReprInfo(_, args, ret)) =
226231
and accArgReprInfo cenv env (argInfo: ArgReprInfo) =
227232
accAttribs cenv env argInfo.Attribs
228233

229-
and accVal cenv env v =
234+
and accVal cenv env (backupRange: Text.range) v =
230235
v.Attribs |> accAttribs cenv env
231236
v.ValReprInfo |> Option.iter (accValReprInfo cenv env)
232-
v.Type |> accTy cenv env
237+
v.Type |> accTy cenv env backupRange
233238

234239
and accBind cenv env (bind: Binding) =
235-
accVal cenv env bind.Var
240+
accVal cenv env bind.Expr.Range bind.Var
236241
let valReprInfo = match bind.Var.ValReprInfo with Some info -> info | _ -> ValReprInfo.emptyValData
237242
accLambdas cenv env valReprInfo bind.Expr bind.Var.Type
238243

@@ -245,7 +250,7 @@ let accTyconRecdField cenv env _tycon (rfield:RecdField) =
245250

246251
let accTycon cenv env (tycon:Tycon) =
247252
accAttribs cenv env tycon.Attribs
248-
abstractSlotValsOfTycons [tycon] |> List.iter (accVal cenv env)
253+
abstractSlotValsOfTycons [tycon] |> List.iter (accVal cenv env tycon.Range)
249254
tycon.AllFieldsArray |> Array.iter (accTyconRecdField cenv env tycon)
250255
if tycon.IsUnionTycon then (* This covers finite unions. *)
251256
tycon.UnionCasesArray |> Array.iter (fun uc ->

‎tests/FSharp.Compiler.ComponentTests/ConstraintSolver/ObjInference.fs‎

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,6 @@ module ObjInference =
99

1010
let warningCases =
1111
[
12-
// TODO: for this case, we're definitely emitting the warning (according to the debugger),
13-
// but somehow it's not showing up in the output?
14-
"""let f<'b> () : 'b = (let a = failwith "" in unbox a)""", 1, 1, 1, 1
1512
"let f() = ([] = [])", 1, 17, 1, 19
1613
"""System.Object.ReferenceEquals(null, "hello") |> ignore""", 1, 31, 1, 35
1714
"""System.Object.ReferenceEquals("hello", null) |> ignore""", 1, 40, 1, 44
@@ -28,8 +25,26 @@ module ObjInference =
2825
|> shouldFail
2926
|> withSingleDiagnostic (Warning 3525, Line line1, Col col1, Line line2, Col col2, message)
3027

28+
[<Fact>]
29+
let ``Three types refined to obj are all warned`` () =
30+
FSharp """let f<'b> () : 'b = (let a = failwith "" in unbox a)"""
31+
|> withErrorRanges
32+
|> withWarnOn 3525
33+
|> typecheck
34+
|> shouldFail
35+
|> withDiagnostics
36+
[
37+
// The `failwith ""` case
38+
Warning 3525, Line 1, Col 30, Line 1, Col 41, message
39+
// The `unbox a` case
40+
Warning 3525, Line 1, Col 45, Line 1, Col 52, message
41+
// The `unbox` case
42+
Warning 3525, Line 1, Col 45, Line 1, Col 50, message
43+
]
44+
3145
let noWarningCases =
3246
[
47+
// TODO: this test is failing, it thinks `x` was inferred as obj even though it wasn't
3348
"let add x y = x + y" // inferred as int
3449
"let f x = string x" // inferred as generic 'a -> string
3550
"let f() = ([] = ([] : obj list))" // obj is inferred, but is annotated

0 commit comments

Comments
 (0)