zcompilercodegenerator.vb

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

                test.AppendLine("        End If")
                test.AppendLine("    End Function")
                test.AppendLine()
                test.AppendLine("    Sub Tester(ByRef value As " & type & ")")
                test.AppendLine("        value = " & value)
                test.AppendLine("    End Sub")
                test.AppendLine("End Module")
                test.AppendLine()

                WriteFile(path, name & ".vb", test.ToString)
                all.Append(test.ToString)
            Next
        End Sub

        Sub GenArrayElements()
            Const path As String = BASEPATHTESTS & "ArrayElements"
            Dim test As System.Text.StringBuilder
            For i As Integer = 0 To VB.UBound(TYPES)
                test = New System.Text.StringBuilder
                Dim type As String = TYPES(i)
                Dim value As String = TYPEVALUES(i)
                Dim value2 As String = TYPEVALUES2(i)
                Dim name As String = "Array" & type & "Elements1"
                test.AppendLine("Module " & name)
                test.AppendLine("    Function Main() As Integer")
                test.AppendLine("        Dim result As Boolean")
                test.AppendLine("        Dim testvalue(" & i.ToString & ") As " & type)
                test.AppendLine("")
                test.AppendLine("        testvalue(" & i.ToString & ") = " & value)
                test.AppendLine("        result = testvalue(" & i.ToString & ") = " & value)
                test.AppendLine("")
                test.AppendLine("        If result = False Then")
                test.AppendLine("            System.Console.WriteLine(""FAIL " & name & """)")
                test.AppendLine("            Return 1")
                test.AppendLine("        End If")
                test.AppendLine("    End Function")
                test.AppendLine()
                test.AppendLine("End Module")
                test.AppendLine()

                WriteFile(path, name & ".vb", test.ToString)
            Next
        End Sub

        Sub GenSelfTest()
            'Extracts all code files from the vbproj file.
            Dim PROJFILENAMEs As String = BASEPATH & "vbnc\source\vbnc.vbproj"
            Dim RSPFILENAMEs As String = BASEPATH & "vbnc\tests\SelfTest\SelfCompile.files.windows"
            Dim RSPFILENAMELINUX As String = BASEPATH & "vbnc\tests\SelfTest\SelfCompile.files.linux"
            Dim newPaths As String = "..\..\source\"

            Dim projFileName As String
            Dim rspFileName As String
            projFileName = PROJFILENAMEs
            rspFileName = RSPFILENAMEs

            If IO.File.Exists(projFileName) = False Then
                Return
            End If

            Dim files As New Text.StringBuilder
            Using x As New Xml.XmlTextReader(projFileName)
                Dim i As Integer
                While x.Read()
                    Dim filename As String
                    Dim prefix As String
                    prefix = ""
                    filename = ""
                    If x.Name = "Compile" AndAlso x.NodeType = Xml.XmlNodeType.Element Then
                        x.MoveToAttribute("Include")
                        filename = x.Value
                    ElseIf x.Name = "EmbeddedResource" AndAlso x.NodeType = Xml.XmlNodeType.Element Then
                        x.MoveToAttribute("Include")
                        filename = x.Value
                        prefix = "/res:"
                    End If
                    If filename <> "" Then
                        filename = IO.Path.Combine(newPaths, x.Value)
                        filename = filename.Replace("%29", ")")
                        filename = filename.Replace("%28", "(")
                        files.AppendLine("""" & prefix & filename & """")
                        i += 1
                    End If
                End While
                'Diagnostics.Debug.WriteLine("Total: " & i.ToString)
                files.AppendLine("# Total: " & i.ToString & " files.")
            End Using
            WriteFile(rspFileName, files.ToString)

            Dim file As String = IO.Path.Combine(IO.Path.GetDirectoryName(RSPFILENAMEs), "SelfCompileWindows.vb")
            Dim text As String = "'Created version " & Reflection.Assembly.GetExecutingAssembly.GetName.Version.ToString & VB.vbNewLine
            If IO.File.ReadAllText(file).Contains(text) = False Then
                IO.File.AppendAllText(file, text)
            End If
            Try
                IO.File.WriteAllText(RSPFILENAMELINUX, IO.File.ReadAllText(RSPFILENAMEs).Replace("\", "/"))
            Catch
            End Try
        End Sub

        Sub GenRuntimeTest()
            'Extracts all code files from the vbproj file.
            Dim PATH As String = IO.Path.GetDirectoryName(IO.Path.GetDirectoryName(BASEPATH))
            Dim PROJFILENAMEs As String = PATH & "\mono-basic\vbruntime\Microsoft.VisualBasic\2005VB.vbproj"
            Dim RSPFILENAMEs As String = BASEPATH & "\vbnc\tests\VBRunTime\Microsoft.VisualBasic.files.windows"
            Dim RSPFILENAMELINUX As String = BASEPATH & "\vbnc\tests\VBRunTime\Microsoft.VisualBasic.files.linux"
            Dim newPaths As String = "..\..\..\..\mono-basic\vbruntime\Microsoft.VisualBasic\"

            Dim projFileName As String
            Dim rspFileName As String
            projFileName = PROJFILENAMEs
            rspFileName = RSPFILENAMEs

            If IO.File.Exists(projFileName) = False Then
                Return
            End If

            Dim files As New Text.StringBuilder
            Using x As New Xml.XmlTextReader(projFileName)
                Dim i As Integer
                While x.Read()
                    Dim filename As String
                    Dim prefix As String
                    prefix = ""
                    filename = ""
                    If x.Name = "Compile" AndAlso x.NodeType = Xml.XmlNodeType.Element Then
                        x.MoveToAttribute("Include")
                        filename = x.Value
                    ElseIf x.Name = "EmbeddedResource" AndAlso x.NodeType = Xml.XmlNodeType.Element Then
                        x.MoveToAttribute("Include")
                        filename = x.Value
                        prefix = "/res:"
                    End If
                    If filename <> "" Then
                        filename = newPaths & x.Value
                        filename = filename.Replace("%29", ")")
                        filename = filename.Replace("%28", "(")
                        files.AppendLine("""" & prefix & filename & """")
                        i += 1
                    End If
                End While
                files.AppendLine("""/keyfile:" & newPaths & "msfinal.pub""")
                'Diagnostics.Debug.WriteLine("Total: " & i.ToString)
                files.AppendLine("# Total: " & i.ToString & " files.")
            End Using
            WriteFile(rspFileName, files.ToString)

            Try
                IO.File.WriteAllText(RSPFILENAMELINUX, IO.File.ReadAllText(RSPFILENAMEs).Replace("\", "/"))
            Catch
            End Try
        End Sub

        Function pGenTypeCombinations() As String
            Dim result As String = ""
            Dim vals() As Integer = CType([Enum].GetValues(GetType(TypeCode)), Integer())
            For i As Integer = 0 To VB.UBound(vals)
                For j As Integer = 0 To VB.UBound(vals)
                    Dim i1, j1 As TypeCode
                    i1 = CType(vals(i), TypeCode)
                    j1 = CType(vals(j), TypeCode)
                    result &= i1.ToString & "_" & j1.ToString & " = TypeCode." & i1.ToString & " << SHIFT Or TypeCode." & j1.ToString & VB.vbNewLine
                Next
            Next
            Dim d As Short = 3S
            Return result
        End Function

        Sub pGen1()
            Dim tp As ArrayList = BUILTINTYPES

            Dim code As New Text.StringBuilder
            Dim t1, t2 As Type
            Dim className As String = "Gen1"
            Dim conversion As ConversionType
            Dim iCount As Integer
            code.AppendLine("Public Class " & className)
            For i As Integer = 0 To tp.Count - 1
                For j As Integer = 0 To tp.Count - 1
                    t1 = DirectCast(tp(i), Type)
                    t2 = DirectCast(tp(j), Type)
                    If i <> j Then
                        conversion = TypeResolution.Conversion(Helper.GetTypeCode(Nothing, t1), Helper.GetTypeCode(Nothing, t2)).Conversion
                        If conversion = ConversionType.Explicit Then
                            'code.AppendLine("   'Explicit conversion")
                        Else
                            code.AppendLine("   'Implicit conversion")
                            code.AppendLine("   Public Function " & t1.Name & "_To_" & t2.Name & "() As Object")
                            code.AppendLine("       Throw New NotImplementedException()")
                            code.AppendLine("   End Function")
                            code.AppendLine()
                            iCount += 1
                        End If
                    End If
                Next
            Next
            code.AppendLine("End Class")
            code.Insert(0, String.Format("'A total of {0} functions have been generated." & VB.vbNewLine, iCount.ToString))
            IO.File.WriteAllText("Auto Gen\" & className & ".vb", code.ToString)
        End Sub

        Sub pGen2()
            Dim path As String = "E:\Rolf\Proyectos\VB.NET\Compilers\vbnc\public\vbnc\test\Temp"
            Dim files As String() = IO.Directory.GetFiles(path, "*.vb")
            For Each str As String In files
                Dim bld As New Text.StringBuilder
                bld.AppendLine("Public Class " & VB.Left(IO.Path.GetFileNameWithoutExtension(str), str.Length))
                bld.AppendLine("	Sub Test")
                bld.AppendLine()
                bld.AppendLine("	End Sub")
                bld.AppendLine("End Class")
                IO.File.WriteAllText(str, bld.ToString)
            Next
        End Sub

    End Module
End Namespace
#End If