Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
dotNET Platform
fsharp
提交
2c3ff6d1
F
fsharp
项目概览
dotNET Platform
/
fsharp
大约 1 年 前同步成功
通知
0
Star
1
Fork
0
代码
文件
提交
分支
Tags
贡献者
分支图
Diff
Issue
0
列表
看板
标记
里程碑
合并请求
0
DevOps
流水线
流水线任务
计划
Wiki
0
Wiki
分析
仓库
DevOps
项目成员
Pages
F
fsharp
项目概览
项目概览
详情
发布
仓库
仓库
文件
提交
分支
标签
贡献者
分支图
比较
Issue
0
Issue
0
列表
看板
标记
里程碑
合并请求
0
合并请求
0
Pages
DevOps
DevOps
流水线
流水线任务
计划
分析
分析
仓库分析
DevOps
Wiki
0
Wiki
成员
成员
收起侧边栏
关闭侧边栏
动态
分支图
创建新Issue
流水线任务
提交
Issue看板
体验新版 GitCode,发现更多精彩内容 >>
未验证
提交
2c3ff6d1
编写于
9月 09, 2022
作者:
D
Don Syme
提交者:
GitHub
9月 09, 2022
1
浏览文件
操作
浏览文件
下载
电子邮件补丁
差异文件
fix 12761 (#13865)
上级
2b391ff2
变更
4
隐藏空白更改
内联
并排
Showing
4 changed file
with
99 addition
and
4 deletion
+99
-4
src/Compiler/CodeGen/IlxGen.fs
src/Compiler/CodeGen/IlxGen.fs
+7
-1
src/Compiler/TypedTree/TypedTreeOps.fs
src/Compiler/TypedTree/TypedTreeOps.fs
+17
-2
src/Compiler/TypedTree/TypedTreeOps.fsi
src/Compiler/TypedTree/TypedTreeOps.fsi
+6
-1
tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs
...e.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs
+69
-0
未找到文件。
src/Compiler/CodeGen/IlxGen.fs
浏览文件 @
2c3ff6d1
...
@@ -6804,7 +6804,13 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN
...
@@ -6804,7 +6804,13 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN
NestedTypeRefForCompLoc
eenvouter
.
cloc
cloName
NestedTypeRefForCompLoc
eenvouter
.
cloc
cloName
// Collect the free variables of the closure
// Collect the free variables of the closure
let
cloFreeVarResults
=
freeInExpr
(
CollectTyparsAndLocalsWithStackGuard
()
)
expr
let
cloFreeVarResults
=
let
opts
=
CollectTyparsAndLocalsWithStackGuard
()
let
opts
=
match
eenvouter
.
tyenv
.
TemplateReplacement
with
|
None
->
opts
|
Some
(
tcref
,
_,
typars
,
_)
->
opts
.
WithTemplateReplacement
(
tyconRefEq
g
tcref
,
typars
)
freeInExpr
opts
expr
// Partition the free variables when some can be accessed from places besides the immediate environment
// Partition the free variables when some can be accessed from places besides the immediate environment
// Also filter out the current value being bound, if any, as it is available from the "this"
// Also filter out the current value being bound, if any, as it is available from the "this"
...
...
src/Compiler/TypedTree/TypedTreeOps.fs
浏览文件 @
2c3ff6d1
...
@@ -2133,7 +2133,10 @@ type FreeVarOptions =
...
@@ -2133,7 +2133,10 @@ type FreeVarOptions =
includeRecdFields
:
bool
includeRecdFields
:
bool
includeUnionCases
:
bool
includeUnionCases
:
bool
includeLocals
:
bool
includeLocals
:
bool
templateReplacement
:
((
TyconRef
->
bool
)
*
Typars
)
option
stackGuard
:
StackGuard
option
}
stackGuard
:
StackGuard
option
}
member
this
.
WithTemplateReplacement
(
f
,
typars
)
=
{
this
with
templateReplacement
=
Some
(
f
,
typars
)
}
let
CollectAllNoCaching
=
let
CollectAllNoCaching
=
{
canCache
=
false
{
canCache
=
false
...
@@ -2144,6 +2147,7 @@ let CollectAllNoCaching =
...
@@ -2144,6 +2147,7 @@ let CollectAllNoCaching =
includeUnionCases
=
true
includeUnionCases
=
true
includeTypars
=
true
includeTypars
=
true
includeLocals
=
true
includeLocals
=
true
templateReplacement
=
None
stackGuard
=
None
}
stackGuard
=
None
}
let
CollectTyparsNoCaching
=
let
CollectTyparsNoCaching
=
...
@@ -2155,6 +2159,7 @@ let CollectTyparsNoCaching =
...
@@ -2155,6 +2159,7 @@ let CollectTyparsNoCaching =
includeRecdFields
=
false
includeRecdFields
=
false
includeUnionCases
=
false
includeUnionCases
=
false
includeLocals
=
false
includeLocals
=
false
templateReplacement
=
None
stackGuard
=
None
}
stackGuard
=
None
}
let
CollectLocalsNoCaching
=
let
CollectLocalsNoCaching
=
...
@@ -2166,6 +2171,7 @@ let CollectLocalsNoCaching =
...
@@ -2166,6 +2171,7 @@ let CollectLocalsNoCaching =
includeRecdFields
=
false
includeRecdFields
=
false
includeUnionCases
=
false
includeUnionCases
=
false
includeLocals
=
true
includeLocals
=
true
templateReplacement
=
None
stackGuard
=
None
}
stackGuard
=
None
}
let
CollectTyparsAndLocalsNoCaching
=
let
CollectTyparsAndLocalsNoCaching
=
...
@@ -2177,6 +2183,7 @@ let CollectTyparsAndLocalsNoCaching =
...
@@ -2177,6 +2183,7 @@ let CollectTyparsAndLocalsNoCaching =
includeUnionCases
=
false
includeUnionCases
=
false
includeTypars
=
true
includeTypars
=
true
includeLocals
=
true
includeLocals
=
true
templateReplacement
=
None
stackGuard
=
None
}
stackGuard
=
None
}
let
CollectAll
=
let
CollectAll
=
...
@@ -2188,6 +2195,7 @@ let CollectAll =
...
@@ -2188,6 +2195,7 @@ let CollectAll =
includeUnionCases
=
true
includeUnionCases
=
true
includeTypars
=
true
includeTypars
=
true
includeLocals
=
true
includeLocals
=
true
templateReplacement
=
None
stackGuard
=
None
}
stackGuard
=
None
}
let
CollectTyparsAndLocalsImpl
stackGuardOpt
=
// CollectAll
let
CollectTyparsAndLocalsImpl
stackGuardOpt
=
// CollectAll
...
@@ -2199,6 +2207,7 @@ let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll
...
@@ -2199,6 +2207,7 @@ let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll
includeLocalTyconReprs
=
false
includeLocalTyconReprs
=
false
includeRecdFields
=
false
includeRecdFields
=
false
includeUnionCases
=
false
includeUnionCases
=
false
templateReplacement
=
None
stackGuard
=
stackGuardOpt
}
stackGuard
=
stackGuardOpt
}
...
@@ -2219,12 +2228,18 @@ let accFreeLocalTycon opts x acc =
...
@@ -2219,12 +2228,18 @@ let accFreeLocalTycon opts x acc =
if
Zset
.
contains
x
acc
.
FreeTycons
then
acc
else
if
Zset
.
contains
x
acc
.
FreeTycons
then
acc
else
{
acc
with
FreeTycons
=
Zset
.
add
x
acc
.
FreeTycons
}
{
acc
with
FreeTycons
=
Zset
.
add
x
acc
.
FreeTycons
}
let
accFreeTycon
opts
(
tcref
:
TyconRef
)
acc
=
let
rec
accFreeTycon
opts
(
tcref
:
TyconRef
)
acc
=
let
acc
=
match
opts
.
templateReplacement
with
|
Some
(
isTemplateTyconRef
,
cloFreeTyvars
)
when
isTemplateTyconRef
tcref
->
let
cloInst
=
List
.
map
mkTyparTy
cloFreeTyvars
accFreeInTypes
opts
cloInst
acc
|
_
->
acc
if
not
opts
.
includeLocalTycons
then
acc
if
not
opts
.
includeLocalTycons
then
acc
elif
tcref
.
IsLocalRef
then
accFreeLocalTycon
opts
tcref
.
ResolvedTarget
acc
elif
tcref
.
IsLocalRef
then
accFreeLocalTycon
opts
tcref
.
ResolvedTarget
acc
else
acc
else
acc
let
rec
boundTypars
opts
tps
acc
=
and
boundTypars
opts
tps
acc
=
// Bound type vars form a recursively-referential set due to constraints, e.g. A: I<B>, B: I<A>
// Bound type vars form a recursively-referential set due to constraints, e.g. A: I<B>, B: I<A>
// So collect up free vars in all constraints first, then bind all variables
// So collect up free vars in all constraints first, then bind all variables
let
acc
=
List
.
foldBack
(
fun
(
tp
:
Typar
)
acc
->
accFreeInTyparConstraints
opts
tp
.
Constraints
acc
)
tps
acc
let
acc
=
List
.
foldBack
(
fun
(
tp
:
Typar
)
acc
->
accFreeInTyparConstraints
opts
tp
.
Constraints
acc
)
tps
acc
...
...
src/Compiler/TypedTree/TypedTreeOps.fsi
浏览文件 @
2c3ff6d1
...
@@ -796,7 +796,12 @@ val emptyFreeLocals: FreeLocals
...
@@ -796,7 +796,12 @@ val emptyFreeLocals: FreeLocals
val
unionFreeLocals
:
FreeLocals
->
FreeLocals
->
FreeLocals
val
unionFreeLocals
:
FreeLocals
->
FreeLocals
->
FreeLocals
type
FreeVarOptions
/// Represents the options to activate when collecting free variables
[<
Sealed
>]
type
FreeVarOptions
=
/// During backend code generation of state machines, register a template replacement for struct types.
/// This may introduce new free variables related to the instantiation of the struct type.
member
WithTemplateReplacement
:
(
TyconRef
->
bool
)
*
Typars
->
FreeVarOptions
val
CollectLocalsNoCaching
:
FreeVarOptions
val
CollectLocalsNoCaching
:
FreeVarOptions
...
...
tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs
浏览文件 @
2c3ff6d1
...
@@ -1259,6 +1259,75 @@ type BasicsNotInParallel() =
...
@@ -1259,6 +1259,75 @@ type BasicsNotInParallel() =
require
ran
"never ran"
)
require
ran
"never ran"
)
taskOuter
.
Wait
()
taskOuter
.
Wait
()
[<
Fact
;
>]
member
_.
testGenericBackgroundTasks
()
=
printfn
"Running testBackgroundTask..."
for
i
in
1
..
5
do
let
mutable
ran
=
false
let
mutable
posted
=
false
let
oldSyncContext
=
SynchronizationContext
.
Current
let
syncContext
=
{
new
SynchronizationContext
()
with
member
_.
Post
(
d
,
state
)
=
posted
<-
true
;
d
.
Invoke
(
state
)
}
try
SynchronizationContext
.
SetSynchronizationContext
syncContext
let
f
(
result
:
'
T
ref
)
(
x
:
'
T
)
=
backgroundTask
{
require
(
System
.
Threading
.
Thread
.
CurrentThread
.
IsThreadPoolThread
)
"expect to be on background thread"
ran
<-
true
result
.
Value
<-
x
}
let
t
=
f
(
ref
""
)
"hello"
t
.
Wait
()
let
t2
=
f
(
ref
1
)
1
t2
.
Wait
()
require
ran
"never ran"
require
(
not
posted
)
"did not expect post to sync context"
finally
SynchronizationContext
.
SetSynchronizationContext
oldSyncContext
/// https://github.com/dotnet/fsharp/issues/12761
module
Test12761A
=
type
Dto
=
{
DtoValue
:
string
Key
:
string
}
type
MyGenericType
<
'
Key
,
'
Value
>
=
{
Value
:
'
Value
Key
:
'
Key
}
type
ProblematicType
<
'
Key
,
'
Value
,
'
Dto
,
'
E
>(
fromDto
:
'
Dto
->
Result
<
MyGenericType
<
'
Key
,
'
Value
>,
'
E
>
)
=
let
myTask
=
backgroundTask
{
let
dto
=
"""{"
DtoValue
":"
1
","
Key
":"
key1
"}"""
|>
box
|>
unbox
<
'
Dto
>
return
fromDto
dto
|>
printfn
"%A"
}
member
__.
ContainsKey
=
fun
(
key
:
'
Key
)
->
true
type
MyType
=
MyGenericType
<
string
,
int
>
module
MyType
=
let
fromDto
(
dto
:
Dto
)
=
try
{
Value
=
int
dto
.
DtoValue
Key
=
dto
.
Key
}
|>
Ok
with
|
e
->
Error
e
/// https://github.com/dotnet/fsharp/issues/12761
module
Test12761B
=
let
TestFunction
<
'
Dto
>()
=
backgroundTask
{
let
dto
=
Unchecked
.
defaultof
<
'
Dto
>
System
.
Console
.
WriteLine
(
dto
)
}
type
Issue12184
()
=
type
Issue12184
()
=
member
this
.
TaskMethod
()
=
member
this
.
TaskMethod
()
=
task
{
task
{
...
...
麦壳饼
@mysticboy
mentioned in commit
13769a82
·
11月 01, 2022
mentioned in commit
13769a82
mentioned in commit 13769a82172fdedf6ba597312be7362c17d5efda
开关提交列表
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录