zcompilercodegenerator.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

' 
' Visual Basic.Net Compiler
' Copyright (C) 2004 - 2007 Rolf Bjarne Kvinge, [e-mail]
' 
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public
' License as published by the Free Software Foundation; either
' version 2.1 of the License, or (at your option) any later version.
' 
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' Lesser General Public License for more details.
' 
' You should have received a copy of the GNU Lesser General Public
' License along with this library; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
' 

Imports Microsoft.VisualBasic
#If GENERATOR Then

Namespace Z
    Module Generator
        Private BUILTINTYPES As New ArrayList(New Type() {GetType(Byte), GetType(SByte), GetType(Short), GetType(UShort), GetType(Integer), GetType(UInteger), GetType(Long), GetType(ULong), GetType(Decimal), GetType(Single), GetType(Double), GetType(String), GetType(Boolean), GetType(Char), GetType(Date), GetType(Object)})

        Private TYPES() As String = {"Byte", "SByte", "Short", "UShort", "Integer", "UInteger", "Long", "ULong", "Decimal", "Single", "Double", "String", "Boolean", "Char", "Date", "Object"}
        Private TYPES2() As Type = {GetType(Byte), GetType(SByte), GetType(Short), GetType(UShort), GetType(Integer), GetType(UInteger), GetType(Long), GetType(ULong), GetType(Decimal), GetType(Single), GetType(Double), GetType(String), GetType(Boolean), GetType(Char), GetType(Date), GetType(Object)}
        Private TYPEVALUES() As String = {"CByte(10)", "CSByte(20)", "30S", "40US", "50I", "60UI", "70L", "80UL", "90.09D", "100.001!", "110.011", """testvalue""", "True", """C""c", "#01/01/2000 12:34#", "Nothing"}
        Private TYPEVALUES2() As String = {"CByte(11)", "CSByte(21)", "31S", "41US", "51I", "61UI", "71L", "81UL", "91.09D", "101.001!", "111.011", """failed""", "False", """X""c", "#12/31/1999 12:34#", """Something"""}
        Private TYPEVALUES3() As String = {"CByte(1)", "CSByte(1)", "1S", "1US", "1I", "1UI", "1L", "1UL", "1D", "1!", "1", """1""", "True", """1""c", "#01/01/2000 12:34#", "Nothing"}
        Private CONVERSIONS() As String = {"CByte", "CSByte", "CShort", "CUShort", "CInt", "CUInt", "CLng", "CULng", "CDec", "CSng", "CDbl", "CStr", "CBool", "CChar", "CDate", "CObj"}

        Private BINARYOPERATORS() As String = {"=", "+", "-", "*", "/", "\", "^", "Mod", "And", "AndAlso", "Or", "OrElse", "XOr", ">", ">>", "<", "<<", "<=", ">=", "<>", "&", "Like"}
        Private BINARYOPERATORSKS() As KS = {KS.Equals, KS.Add, KS.Minus, KS.Mult, KS.RealDivision, KS.IntDivision, KS.Power, KS.Mod, KS.And, KS.AndAlso, KS.Or, KS.OrElse, KS.Xor, KS.GT, KS.ShiftRight, KS.LT, KS.ShiftLeft, KS.LE, KS.GE, KS.NotEqual, KS.Concat, KS.Like}
        Private BINARYOPERATORSNAME() As String = {"Equals", "Add", "Minus", "Multiplication", "RealDivision", "IntegerDivision", "Power", "Mod", "And", "AndAlso", "Or", "OrElse", "XOr", "GreaterThan", "RightShift", "LessThan", "LeftShift", "LessThanOrEqual", "GreaterThanOrEqual", "NotEqual", "Concat", "Like"}

        Private UNARYOPERATORS() As String = {"Not", "-", "+"}
        Private UNARYOPERATORSKS() As KS = {KS.Not, KS.Minus, KS.Add}
        Private UNARYOPERATORSNAME() As String = {"Not", "Minus", "Add"}

        Private ASSIGNMENTOPERATORS() As String = {"+=", "-=", "*=", "/=", "\=", "^=", ">>=", "<<=", "&="}
        Private ASSIGNMENTOPERATORSKS() As KS = {KS.AddAssign, KS.MinusAssign, KS.MultAssign, KS.RealDivAssign, KS.IntDivAssign, KS.PowerAssign, KS.ShiftRightAssign, KS.ShiftLeftAssign, KS.ConcatAssign}
        Private ASSIGNMENTOPERATORSNAME() As String = {"Add", "Minus", "Multiplication", "RealDivision", "IntegerDivision", "Power", "RightShift", "LeftShift", "Concat"}

        Private Const BASEPATH As String = "Z:\mono\head\mono-basic\vbnc\"
        Private Const LICENSE As String = BASEPATH & "\License FileHeader.txt"
        Private Const BASEPATHTESTS As String = BASEPATH & "\vbnc\tests\Generated\"


        ''' <summary>
        ''' This method generates all auto generated tests.
        ''' </summary>
        ''' <remarks></remarks>
        Sub Generate()
            Try
                Try
                    DeleteFiles(BASEPATHTESTS)
                Catch
                End Try
                GenOperators()
                GenConversions()
                GenConversions2()
                GenByRefs()
                GenArrayElements()
                GenSelfTest()
            Catch ex As Exception
                MsgBox(ex.Message & VB.vbNewLine & ex.StackTrace)
            End Try
        End Sub

        ''' <summary>
        ''' Deletes all vb, pdb, exe and dll files in the directory and subdirectories.
        ''' </summary>
        ''' <param name="Path"></param>
        ''' <remarks></remarks>
        Sub DeleteFiles(ByVal Path As String)
            Using p As New System.Diagnostics.Process()
                p.StartInfo.FileName = System.Environment.ExpandEnvironmentVariables("%COMSPEC%")
                p.StartInfo.WorkingDirectory = Path
                p.StartInfo.Arguments = "/C del /S *.vb *.pdb *.dll *.exe *.exceptions.output.xml"
                p.Start()
                p.WaitForExit()
            End Using
        End Sub

        Sub WriteFile(ByVal Path As String, ByVal File As String, ByVal Contents As String)
            'Static license As String
            'If license Is Nothing Then license = IO.File.ReadAllText(license)
            Dim FileName As String = IO.Path.Combine(Path, File)
            If IO.Directory.Exists(Path) = False Then IO.Directory.CreateDirectory(Path)
            If IO.Directory.Exists(IO.Path.Combine(Path, "testoutput")) = False Then IO.Directory.CreateDirectory(IO.Path.Combine(Path, "testoutput"))
            'If Contents.Contains(license) = False Then Contents = license & Contents
            IO.File.WriteAllText(FileName, Contents)
        End Sub

        Sub WriteFile(ByVal FileName As String, ByVal Contents As String)
            WriteFile(IO.Path.GetDirectoryName(FileName), IO.Path.GetFileName(FileName), Contents)
        End Sub

        Sub GenUserOperators()
            Const PATH As String = BASEPATHTESTS & "UserOperators"
            Dim code As System.Text.StringBuilder
            Dim testname As String

            For i As Integer = 0 To BINARYOPERATORS.GetUpperBound(0)
                Dim binaryoperator As String = BINARYOPERATORS(i)
                Dim binaryoperatorname As String = BINARYOPERATORSNAME(i)

                If Char.IsLetterOrDigit(binaryoperator.Chars(0)) Then Continue For

                testname = binaryoperatorname & "Operator1"
                code = New Text.StringBuilder()
                code.AppendLine("Module " & testname)
                code.AppendLine(vbTab & "Class Operand")
                code.AppendLine(vbTab & vbTab & "Public Number as Integer")
                code.AppendLine(vbTab & vbTab & "Shared Operator " & binaryoperator & "(ByVal op1 As Operand, ByVal op2 As Operand) As Integer")
                code.AppendLine(vbTab & vbTab & vbTab & "Return op1.Number + op2.Number")
                code.AppendLine(vbTab & vbTab & "End Operator")
                code.AppendLine(vbTab & "End Class")
                code.AppendLine(vbTab & "Class Consumer")
                code.AppendLine(vbTab & vbTab & "Shared Function Main() As Integer")
                code.AppendLine(vbTab & vbTab & vbTab & "Dim o1 As New Operand, o2 As New Operand")
                code.AppendLine(vbTab & vbTab & vbTab & "Dim i As Integer")
                code.AppendLine(vbTab & vbTab & vbTab & "")
                code.AppendLine(vbTab & vbTab & vbTab & "o1.Number = 1")
                code.AppendLine(vbTab & vbTab & vbTab & "o2.Number = 2")
                code.AppendLine(vbTab & vbTab & vbTab & "")
                code.AppendLine(vbTab & vbTab & vbTab & "i = o1 " & binaryoperator & " o2")
                code.AppendLine(vbTab & vbTab & vbTab & "")
                code.AppendLine(vbTab & vbTab & vbTab & "If i = 3 Then")
                code.AppendLine(vbTab & vbTab & vbTab & vbTab & "Return 0")
                code.AppendLine(vbTab & vbTab & vbTab & "Else")
                code.AppendLine(vbTab & vbTab & vbTab & vbTab & "Return 1")
                code.AppendLine(vbTab & vbTab & vbTab & "End If")
                code.AppendLine(vbTab & vbTab & "End Function")
                code.AppendLine(vbTab & "End Class")
                code.AppendLine("End Module")

                WriteFile(PATH, testname & ".vb", code.ToString)
            Next
        End Sub

        Sub GenOperators()
            Const path As String = BASEPATHTESTS & "Operators"
            Dim code As New System.Text.StringBuilder(2000)
            Dim errname As String = ""

            For i As Integer = 0 To VB.UBound(TYPES)
                Dim lefttype As String = TYPES(i)
                Dim lefttypecode As TypeCode = Helper.GetTypeCode(Nothing, TYPES2(i))

                For k As Integer = 0 To VB.UBound(UNARYOPERATORS)
                    Dim unaryop As String = UNARYOPERATORS(k)
                    Dim unaryopname As String = UNARYOPERATORSNAME(k)
                    Dim unaryname As String = "UnaryOperator_" & unaryopname & "_" & lefttype

                    Dim resulttypecode As TypeCode = TypeConverter.GetUnaryResultType(UNARYOPERATORSKS(k), lefttypecode)
                    Dim resulttype As String

                    If resulttypecode = TypeCode.Empty Then
                        resulttype = "Object" 'This test is supposed to fail.
                        errname = "30487 "
                    Else
                        errname = ""
                        resulttype = TypeCodeToType(resulttypecode).FullName
                    End If
                    code.Length = 0
                    code.AppendLine("Public Module " & unaryname & "1")
                    code.AppendLine(vbTab & "Public Function Main() As Integer")
                    code.AppendLine(vbTab & vbTab & "Dim leftvalue As " & lefttype)
                    code.AppendLine(vbTab & vbTab & "Dim result As " & resulttype)
                    code.AppendLine()
                    code.AppendLine(vbTab & vbTab & "leftvalue = " & TYPEVALUES3(i))
                    code.AppendLine()
                    code.AppendLine(vbTab & vbTab & "result = " & unaryop & " leftvalue")
                    code.AppendLine(vbTab & "End Function")
                    code.AppendLine("End Module")
                    WriteFile(IO.Path.Combine(path, "Unary"), errname & unaryname & "1.vb", code.ToString)
                Next

                For j As Integer = 0 To VB.UBound(TYPES)
                    Dim righttype As String = TYPES(j)
                    Dim righttypecode As TypeCode = Helper.GetTypeCode(Nothing, TYPES2(j))
                    For k As Integer = 0 To VB.UBound(BINARYOPERATORS)
                        Dim binaryop As String = BINARYOPERATORS(k)
                        Dim binaryopname As String = BINARYOPERATORSNAME(k)
                        Dim binaryname As String = "BinaryOperator_" & binaryopname & "_" & lefttype & "_" & righttype
                        Dim resulttypecode As TypeCode = TypeConverter.GetBinaryResultType(BINARYOPERATORSKS(k), lefttypecode, righttypecode)
                        Dim resulttype As String

                        errname = ""
                        If resulttypecode = TypeCode.Empty Then
                            resulttype = "Object" 'This test is supposed to fail.
                            If (binaryop = "<<" OrElse binaryop = ">>") AndAlso lefttype <> "Date" AndAlso lefttype <> "Char" Then
                                If righttype = "Date" Then
                                    errname = "30311 "
                                ElseIf righttype = "Char" Then
                                    errname = "32006 "
                                End If
                            End If
                            If errname = "" Then errname = "30452 "
                        Else
                            resulttype = TypeCodeToType(resulttypecode).FullName
                        End If
                        code.Length = 0
                        code.AppendLine("Public Module " & binaryname & "1")
                        code.AppendLine(vbTab & "Public Function Main() As Integer")
                        code.AppendLine(vbTab & vbTab & "Dim leftvalue As " & lefttype)
                        code.AppendLine(vbTab & vbTab & "Dim rightvalue As " & righttype)
                        code.AppendLine(vbTab & vbTab & "Dim result As " & resulttype)
                        code.AppendLine()
                        code.AppendLine(vbTab & vbTab & "leftvalue = " & TYPEVALUES3(i))
                        code.AppendLine(vbTab & vbTab & "rightvalue = " & TYPEVALUES3(j))
                        code.AppendLine()
                        code.AppendLine(vbTab & vbTab & "result = leftvalue " & binaryop & " rightvalue")
                        code.AppendLine(vbTab & "End Function")
                        code.AppendLine("End Module")
                        WriteFile(IO.Path.Combine(path, "Binary"), errname & binaryname & "1.vb", code.ToString)
                    Next