Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
dotNET Platform
fsharp
提交
bf332b50
F
fsharp
项目概览
dotNET Platform
/
fsharp
12 个月 前同步成功
通知
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,发现更多精彩内容 >>
未验证
提交
bf332b50
编写于
10月 14, 2022
作者:
K
Kevin Ransom (msft)
提交者:
GitHub
10月 14, 2022
浏览文件
操作
浏览文件
下载
差异文件
Merge branch 'main' into merges/release/dev17.3-to-main
上级
67bd7312
823f7d5c
变更
5
显示空白变更内容
内联
并排
Showing
5 changed file
with
177 addition
and
193 deletion
+177
-193
src/FSharp.Build/FSharpEmbedResXSource.fs
src/FSharp.Build/FSharpEmbedResXSource.fs
+22
-22
src/FSharp.Build/FSharpEmbedResourceText.fs
src/FSharp.Build/FSharpEmbedResourceText.fs
+44
-45
src/FSharp.Build/SubstituteText.fs
src/FSharp.Build/SubstituteText.fs
+54
-64
src/FSharp.Build/WriteCodeFragment.fs
src/FSharp.Build/WriteCodeFragment.fs
+54
-59
tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs
tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs
+3
-3
未找到文件。
src/FSharp.Build/FSharpEmbedResXSource.fs
浏览文件 @
bf332b50
...
...
@@ -10,14 +10,20 @@ open System.Xml.Linq
open
Microsoft
.
Build
.
Framework
open
Microsoft
.
Build
.
Utilities
type
FSharpEmbedResXSource
()
=
let
mutable
_
buildEngine
:
IBuildEngine
MaybeNull
=
null
let
mutable
_
hostObject
:
ITaskHost
MaybeNull
=
null
type
FSharpEmbedResXSource
()
as
this
=
inherit
Task
()
let
mutable
_
embeddedText
:
ITaskItem
[]
=
[||]
let
mutable
_
generatedSource
:
ITaskItem
[]
=
[||]
let
mutable
_
outputPath
:
string
=
""
let
mutable
_
targetFramework
:
string
=
""
let
failTask
fmt
=
Printf
.
ksprintf
(
fun
msg
->
this
.
Log
.
LogError
msg
raise
TaskFailed
)
fmt
let
boilerplate
=
@
"// <auto-generated>
...
...
@@ -36,7 +42,7 @@ module internal {1} =
let
generateSource
(
resx
:
string
)
(
fullModuleName
:
string
)
(
generateLegacy
:
bool
)
(
generateLiteral
:
bool
)
=
try
let
printMessage
=
printfn
"FSharpEmbedResXSource: %s"
let
printMessage
fmt
=
Printf
.
ksprintf
this
.
Log
.
LogMessage
fmt
let
justFileName
=
Path
.
GetFileNameWithoutExtension
(
resx
)
let
sourcePath
=
Path
.
Combine
(_
outputPath
,
justFileName
+
".fs"
)
...
...
@@ -46,7 +52,7 @@ module internal {1} =
&&
File
.
Exists
(
sourcePath
)
&&
File
.
GetLastWriteTimeUtc
(
resx
)
<=
File
.
GetLastWriteTimeUtc
(
sourcePath
)
then
printMessage
(
sprintf
"Skipping generation: '%s' since it is up-to-date."
sourcePath
)
printMessage
"Skipping generation: '%s' since it is up-to-date."
sourcePath
Some
(
sourcePath
)
else
let
namespaceName
,
moduleName
=
...
...
@@ -63,7 +69,7 @@ module internal {1} =
||
_
targetFramework
.
StartsWith
(
"netcoreapp1."
)
)
printMessage
(
sprintf
"Generating code for target framework %s"
_
targetFramework
)
printMessage
"Generating code for target framework %s"
_
targetFramework
let
sb
=
StringBuilder
()
...
...
@@ -72,7 +78,7 @@ module internal {1} =
if
generateGetObject
then
sb
.
AppendLine
(
boilerplateGetObject
)
|>
ignore
printMessage
<|
sprintf
"Generating: %s"
sourcePath
printMessage
"Generating: %s"
sourcePath
let
body
=
let
xname
=
XName
.
op_Implicit
...
...
@@ -82,12 +88,12 @@ module internal {1} =
(
fun
(
sb
:
StringBuilder
)
(
node
:
XElement
)
->
let
name
=
match
node
.
Attribute
(
xname
"name"
)
with
|
null
->
fail
with
(
sprintf
"Missing resource name on element '%s'"
(
node
.
ToString
()
))
|
null
->
fail
Task
"Missing resource name on element '%O'"
node
|
attr
->
attr
.
Value
let
docComment
=
match
node
.
Elements
(
xname
"value"
).
FirstOrDefault
()
with
|
null
->
fail
with
<|
sprintf
"Missing resource value for '%s'"
name
|
null
->
fail
Task
"Missing resource value for '%s'"
name
|
element
->
element
.
Value
.
Trim
()
let
identifier
=
...
...
@@ -118,7 +124,7 @@ module internal {1} =
sb
File
.
WriteAllText
(
sourcePath
,
body
.
ToString
()
)
printMessage
<|
sprintf
"Done: %s"
sourcePath
printMessage
"Done: %s"
sourcePath
Some
(
sourcePath
)
with
e
->
printf
"An exception occurred when processing '%s'
\n
%s"
resx
(
e
.
ToString
()
)
...
...
@@ -141,16 +147,8 @@ module internal {1} =
[<
Output
>]
member
_.
GeneratedSource
=
_
generatedSource
interface
ITask
with
member
_.
BuildEngine
with
get
()
=
_
buildEngine
and
set
(
value
)
=
_
buildEngine
<-
value
member
_.
HostObject
with
get
()
=
_
hostObject
and
set
(
value
)
=
_
hostObject
<-
value
member
this
.
Execute
()
=
override
this
.
Execute
()
=
try
let
getBooleanMetadata
(
metadataName
:
string
)
(
defaultValue
:
bool
)
(
item
:
ITaskItem
)
=
match
item
.
GetMetadata
(
metadataName
)
with
|
value
when
String
.
IsNullOrWhiteSpace
(
value
)
->
defaultValue
...
...
@@ -158,7 +156,7 @@ module internal {1} =
match
value
.
ToLowerInvariant
()
with
|
"true"
->
true
|
"false"
->
false
|
_
->
fail
with
(
sprintf
"Expected boolean value for '%s' found '%s'"
metadataName
value
)
|
_
->
fail
Task
"Expected boolean value for '%s' found '%s'"
metadataName
value
let
mutable
success
=
true
...
...
@@ -181,4 +179,6 @@ module internal {1} =
|]
_
generatedSource
<-
generatedSource
success
success
&&
not
this
.
Log
.
HasLoggedErrors
with
TaskFailed
->
false
src/FSharp.Build/FSharpEmbedResourceText.fs
浏览文件 @
bf332b50
...
...
@@ -6,24 +6,32 @@ open System.IO
open
Microsoft
.
Build
.
Framework
open
Microsoft
.
Build
.
Utilities
type
FSharpEmbedResourceText
()
=
let
mutable
_
buildEngine
:
IBuildEngine
MaybeNull
=
null
let
mutable
_
hostObject
:
ITaskHost
MaybeNull
=
null
/// A special exception that when thrown signifies that
/// the task should end with failure. It is assumed that
/// the task has already emitted the error message.
exception
TaskFailed
type
FSharpEmbedResourceText
()
as
this
=
inherit
Task
()
let
mutable
_
embeddedText
:
ITaskItem
[]
=
[||]
let
mutable
_
generatedSource
:
ITaskItem
[]
=
[||]
let
mutable
_
generatedResx
:
ITaskItem
[]
=
[||]
let
mutable
_
outputPath
:
string
=
""
let
PrintErr
(
fileName
,
line
,
msg
)
=
printfn
"%s(%d): error : %s"
fileName
line
msg
this
.
Log
.
LogError
(
null
,
null
,
null
,
fileName
,
line
,
0
,
0
,
0
,
msg
,
Array
.
empty
)
let
Err
(
fileName
,
line
,
msg
)
=
PrintErr
(
fileName
,
line
,
msg
)
printfn
"Note that the syntax of each line is one of these three alternatives:"
printfn
"# comment"
printfn
"ident,
\"
string
\"
"
printfn
"errNum,ident,
\"
string
\"
"
failwith
(
sprintf
"there were errors in the file '%s'"
fileName
)
let
hint
=
"Note that the syntax of each line is one of these three alternatives:
# comment
ident,
\"
string
\"
errNum,ident,
\"
string
\"
"
this
.
Log
.
LogMessage
(
MessageImportance
.
High
,
hint
)
raise
TaskFailed
let
xmlBoilerPlateString
=
@
"<?xml version=""1.0"" encoding=""utf-8""?>
...
...
@@ -192,7 +200,7 @@ type FSharpEmbedResourceText() =
if
s
.
StartsWith
"
\"
"
&&
s
.
EndsWith
"
\"
"
then
s
.
Substring
(
1
,
s
.
Length
-
2
)
else
failwith
"error message string should be quoted"
Err
(
null
,
0
,
"error message string should be quoted"
)
let
ParseLine
fileName
lineNum
(
txt
:
string
)
=
let
mutable
errNum
=
None
...
...
@@ -361,8 +369,7 @@ open Printf
let generateResxAndSource (fileName: string) =
try
let printMessage message =
printfn "
FSharpEmbedResourceText
:
%
s
" message
let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt
let justFileName = Path.GetFileNameWithoutExtension(fileName) // .txt
...
...
@@ -391,12 +398,11 @@ open Printf
&& (File.GetLastWriteTimeUtc(fileName) <= File.GetLastWriteTimeUtc(outXmlFileName))
if condition5 then
printMessage
(sprintf "
Skipping
generation
of
%
s
and
%
s
from
%
s
since
up
-
to
-
date
" outFileName outXmlFileName fileName)
printMessage
"
Skipping
generation
of
%
s
and
%
s
from
%
s
since
up
-
to
-
date
" outFileName outXmlFileName fileName
Some(fileName, outFileName, outXmlFileName)
else
printMessage (
sprintf
printMessage
"
Generating
%
s
and
%
s
from
%
s
,
because
condition
%
d
is
false
,
see
FSharpEmbedResourceText
.
fs
in
the
F
#
source
"
outFileName
outXmlFileName
...
...
@@ -406,20 +412,19 @@ open Printf
elif not condition3 then 3
elif not condition4 then 4
else 5)
)
printMessage
(sprintf "
Reading
%
s
" fileName)
printMessage
"
Reading
%
s
" fileName
let lines =
File.ReadAllLines(fileName)
|> Array.mapi (fun i s -> i, s) // keep line numbers
|> Array.filter (fun (i, s) -> not (s.StartsWith "
#
")) // filter out comments
printMessage
(sprintf "
Parsing
%
s
" fileName)
printMessage
"
Parsing
%
s
" fileName
let stringInfos = lines |> Array.map (fun (i, s) -> ParseLine fileName i s)
// now we have array of (lineNum, ident, str, holes, netFormatString) // str has %d, netFormatString has {0}
printMessage
(sprintf "
Validating
%
s
" fileName)
printMessage
"
Validating
%
s
" fileName
// validate that all the idents are unique
let allIdents = new System.Collections.Generic.Dictionary<string, int>()
...
...
@@ -436,7 +441,7 @@ open Printf
allIdents.Add(ident, line)
printMessage
(sprintf "
Validating
uniqueness
of
%
s
" fileName)
printMessage
"
Validating
uniqueness
of
%
s
" fileName
// validate that all the strings themselves are unique
let allStrs = new System.Collections.Generic.Dictionary<string, (int * string)>()
...
...
@@ -456,7 +461,7 @@ open Printf
allStrs.Add(str, (line, ident))
printMessage
(sprintf "
Generating
%
s
" outFileName)
printMessage
"
Generating
%
s
" outFileName
use outStream = File.Create outFileName
use out = new StreamWriter(outStream)
fprintfn out "
// This is a generated file; the original input is '%s'" fileName
...
...
@@ -466,7 +471,7 @@ open Printf
let
theResourceName
=
justFileName
fprintfn
out
"%s"
(
StringBoilerPlate
theResourceName
)
printMessage
(
sprintf
"Generating resource methods for %s"
outFileName
)
printMessage
"Generating resource methods for %s"
outFileName
// gen each resource method
stringInfos
|>
Seq
.
iter
(
fun
(
lineNum
,
(
optErrNum
,
ident
),
str
,
holes
,
netFormatString
)
->
...
...
@@ -520,7 +525,7 @@ open Printf
justPercentsFromFormatString
(
actualArgs
.
ToString
()
))
printMessage
(
sprintf
"Generating .resx for %s"
outFileName
)
printMessage
"Generating .resx for %s"
outFileName
fprintfn
out
""
// gen validation method
fprintfn
out
" /// Call this method once to validate that all known resources are valid; throws if not"
...
...
@@ -548,7 +553,7 @@ open Printf
use
outXmlStream
=
File
.
Create
outXmlFileName
xd
.
Save
outXmlStream
printMessage
(
sprintf
"Done %s"
outFileName
)
printMessage
"Done %s"
outFileName
Some
(
fileName
,
outFileName
,
outXmlFileName
)
with
e
->
PrintErr
(
fileName
,
0
,
sprintf
"An exception occurred when processing '%s'
\n
%s"
fileName
(
e
.
ToString
()
))
...
...
@@ -570,17 +575,9 @@ open Printf
[<
Output
>]
member
_.
GeneratedResx
=
_
generatedResx
interface
ITask
with
member
_.
BuildEngine
with
get
()
=
_
buildEngine
and
set
(
value
)
=
_
buildEngine
<-
value
member
_.
HostObject
with
get
()
=
_
hostObject
and
set
(
value
)
=
_
hostObject
<-
value
member
this
.
Execute
()
=
override
this
.
Execute
()
=
try
let
generatedFiles
=
this
.
EmbeddedText
|>
Array
.
choose
(
fun
item
->
generateResxAndSource
item
.
ItemSpec
)
...
...
@@ -609,4 +606,6 @@ open Printf
_
generatedSource
<-
generatedSource
_
generatedResx
<-
generatedResx
generatedResult
generatedResult
&&
not
this
.
Log
.
HasLoggedErrors
with
TaskFailed
->
false
src/FSharp.Build/SubstituteText.fs
浏览文件 @
bf332b50
...
...
@@ -5,11 +5,10 @@ namespace FSharp.Build
open
System
open
System
.
IO
open
Microsoft
.
Build
.
Framework
open
Microsoft
.
Build
.
Utilities
type
SubstituteText
()
=
let
mutable
_
buildEngine
:
IBuildEngine
MaybeNull
=
null
let
mutable
_
hostObject
:
ITaskHost
MaybeNull
=
null
inherit
Task
()
let
mutable
copiedFiles
=
new
ResizeArray
<
ITaskItem
>()
let
mutable
embeddedResources
:
ITaskItem
[]
=
[||]
...
...
@@ -22,16 +21,7 @@ type SubstituteText() =
[<
Output
>]
member
_.
CopiedFiles
=
copiedFiles
.
ToArray
()
interface
ITask
with
member
_.
BuildEngine
with
get
()
=
_
buildEngine
and
set
(
value
)
=
_
buildEngine
<-
value
member
_.
HostObject
with
get
()
=
_
hostObject
and
set
(
value
)
=
_
hostObject
<-
value
member
_.
Execute
()
=
override
_.
Execute
()
=
copiedFiles
.
Clear
()
if
not
(
isNull
embeddedResources
)
then
...
...
src/FSharp.Build/WriteCodeFragment.fs
浏览文件 @
bf332b50
...
...
@@ -9,14 +9,20 @@ open System.Text
open
Microsoft
.
Build
.
Framework
open
Microsoft
.
Build
.
Utilities
type
WriteCodeFragment
()
=
let
mutable
_
buildEngine
:
IBuildEngine
MaybeNull
=
null
let
mutable
_
hostObject
:
ITaskHost
MaybeNull
=
null
type
WriteCodeFragment
()
as
this
=
inherit
Task
()
let
mutable
_
outputDirectory
:
ITaskItem
MaybeNull
=
null
let
mutable
_
outputFile
:
ITaskItem
MaybeNull
=
null
let
mutable
_
language
:
string
=
""
let
mutable
_
assemblyAttributes
:
ITaskItem
[]
=
[||]
let
failTask
fmt
=
Printf
.
ksprintf
(
fun
msg
->
this
.
Log
.
LogError
msg
raise
TaskFailed
)
fmt
static
let
escapeString
(
str
:
string
)
=
let
sb
=
str
.
ToCharArray
()
...
...
@@ -37,7 +43,7 @@ type WriteCodeFragment() =
sb
.
Append
(
"
\"
"
).
ToString
()
static
member
GenerateAttribute
(
item
:
ITaskItem
,
language
:
string
)
=
member
_.
GenerateAttribute
(
item
:
ITaskItem
,
language
:
string
)
=
let
attributeName
=
item
.
ItemSpec
let
args
=
...
...
@@ -70,7 +76,7 @@ type WriteCodeFragment() =
match
Int32
.
TryParse
indexString
with
|
(
true
,
index
)
->
(
index
,
value
)
|
(
false
,
_)
->
fail
with
(
sprintf
"Unable to parse '%s' as an index"
indexString
)
)
|
(
false
,
_)
->
fail
Task
"Unable to parse '%s' as an index"
indexString
)
|>
List
.
sortBy
fst
// assign ordered parameters to array
let
orderedParametersArray
=
...
...
@@ -96,7 +102,7 @@ type WriteCodeFragment() =
|
"f#"
->
sprintf
"[<assembly: %s(%s)>]"
attributeName
args
|
"c#"
->
sprintf
"[assembly: %s(%s)]"
attributeName
args
|
"vb"
->
sprintf
"<Assembly: %s(%s)>"
attributeName
args
|
_
->
fail
with
"Language name must be one of F#, C# or VB"
|
_
->
fail
Task
"Language name must be one of F#, C# or VB"
// adding this property to maintain API equivalence with the MSBuild task
member
_.
Language
...
...
@@ -116,19 +122,10 @@ type WriteCodeFragment() =
with
get
()
=
_
outputFile
and
set
(
value
)
=
_
outputFile
<-
value
interface
ITask
with
member
_.
BuildEngine
with
get
()
=
_
buildEngine
and
set
(
value
)
=
_
buildEngine
<-
value
member
_.
HostObject
with
get
()
=
_
hostObject
and
set
(
value
)
=
_
hostObject
<-
value
member
_.
Execute
()
=
override
this
.
Execute
()
=
try
match
_
outputFile
with
|
Null
->
failwith
"Output location must be specified"
|
Null
->
failTask
"Output location must be specified"
|
NonNull
outputFile
->
let
boilerplate
=
match
_
language
.
ToLowerInvariant
()
with
...
...
@@ -138,14 +135,14 @@ type WriteCodeFragment() =
"// <auto-generated>
\n
// Generated by the FSharp WriteCodeFragment class.
\n
// </auto-generated>
\n\n
using System;
\n
using System.Reflection;"
|
"vb"
->
"'------------------------------------------------------------------------------
\n
' <auto-generated>
\n
' Generated by the FSharp WriteCodeFragment class.
\n
' </auto-generated>
\n
'------------------------------------------------------------------------------
\n\n
Option Strict Off
\n
Option Explicit On
\n\n
Imports System
\n
Imports System.Reflection"
|
_
->
failwith
"Language name must be one of F#, C# or VB"
|
_
->
failTask
"Language name must be one of F#, C# or VB"
let
sb
=
StringBuilder
()
.
AppendLine
(
boilerplate
).
AppendLine
()
let
code
=
(
sb
,
_
assemblyAttributes
)
||>
Array
.
fold
(
fun
(
sb
:
StringBuilder
)
(
item
:
ITaskItem
)
->
sb
.
AppendLine
(
WriteCodeFragment
.
GenerateAttribute
(
item
,
_
language
.
ToLowerInvariant
()
)))
sb
.
AppendLine
(
this
.
GenerateAttribute
(
item
,
_
language
.
ToLowerInvariant
()
)))
if
_
language
.
ToLowerInvariant
()
=
"f#"
then
code
.
AppendLine
(
"do()"
)
|>
ignore
...
...
@@ -164,8 +161,6 @@ type WriteCodeFragment() =
let
codeText
=
code
.
ToString
()
File
.
WriteAllText
(
fileName
,
codeText
)
_
outputFile
<-
outputFileItem
true
with
e
->
printf
"Error writing code fragment: %s"
(
e
.
ToString
()
)
not
this
.
Log
.
HasLoggedErrors
with
TaskFailed
->
false
tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs
浏览文件 @
bf332b50
...
...
@@ -13,7 +13,7 @@ type WriteCodeFragmentFSharpTests() =
let
verifyAttribute
(
attributeName
:
string
)
(
parameters
:(
string
*
string
)
list
)
(
expectedAttributeText
:
string
)
=
let
taskItem
=
TaskItem
(
attributeName
)
parameters
|>
List
.
iter
(
fun
(
key
,
value
)
->
taskItem
.
SetMetadata
(
key
,
value
))
let
actualAttributeText
=
WriteCodeFragment
.
GenerateAttribute
(
taskItem
:>
ITaskItem
,
"f#"
)
let
actualAttributeText
=
(
new
WriteCodeFragment
()
)
.
GenerateAttribute
(
taskItem
:>
ITaskItem
,
"f#"
)
let
fullExpectedAttributeText
=
"[<assembly: "
+
expectedAttributeText
+
">]"
Assert
.
AreEqual
(
fullExpectedAttributeText
,
actualAttributeText
)
...
...
@@ -43,7 +43,7 @@ type WriteCodeFragmentCSharpTests() =
let
verifyAttribute
(
attributeName
:
string
)
(
parameters
:(
string
*
string
)
list
)
(
expectedAttributeText
:
string
)
=
let
taskItem
=
TaskItem
(
attributeName
)
parameters
|>
List
.
iter
(
fun
(
key
,
value
)
->
taskItem
.
SetMetadata
(
key
,
value
))
let
actualAttributeText
=
WriteCodeFragment
.
GenerateAttribute
(
taskItem
:>
ITaskItem
,
"c#"
)
let
actualAttributeText
=
(
new
WriteCodeFragment
()
)
.
GenerateAttribute
(
taskItem
:>
ITaskItem
,
"c#"
)
let
fullExpectedAttributeText
=
"[assembly: "
+
expectedAttributeText
+
"]"
Assert
.
AreEqual
(
fullExpectedAttributeText
,
actualAttributeText
)
...
...
@@ -75,7 +75,7 @@ type WriteCodeFragmentVisualBasicTests() =
let
verifyAttribute
(
attributeName
:
string
)
(
parameters
:(
string
*
string
)
list
)
(
expectedAttributeText
:
string
)
=
let
taskItem
=
TaskItem
(
attributeName
)
parameters
|>
List
.
iter
(
fun
(
key
,
value
)
->
taskItem
.
SetMetadata
(
key
,
value
))
let
actualAttributeText
=
WriteCodeFragment
.
GenerateAttribute
(
taskItem
:>
ITaskItem
,
"vb"
)
let
actualAttributeText
=
(
new
WriteCodeFragment
()
)
.
GenerateAttribute
(
taskItem
:>
ITaskItem
,
"vb"
)
let
fullExpectedAttributeText
=
"<Assembly: "
+
expectedAttributeText
+
">"
Assert
.
AreEqual
(
fullExpectedAttributeText
,
actualAttributeText
)
...
...
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录