Code-Beispiel

Testsuite Compiler

Lizenz:	Erster Autor:	Letzte Bearbeitung:
WTFPL	MOD	26.01.2014
Angelehnt an meinen Code zum rekursiven Durchsuchen von Dateien, habe ich hier ein kleines Programm gebastelt, das alle FreeBASIC-Codes eines angegebenen Ordners und dessen Unterordner durch einen oder mehrere FreeBASIC-Compiler compilieren lässt. Nach Bedarf können die erstellten Programme dann noch gestartet und auch anschließend gelöscht werden.

Der Code eignet sich also vor allem für Testsuites, bei denen eine Menge Codes als Testdateien definiert sind.
#Include Once "dir.bi"



#Ifndef FALSE

    #Define FALSE 0

    #Define TRUE (Not FALSE)

#EndIf



Type Compiler

    Declare Constructor (fbc As String, compileOptions As String, activated As Integer)



    As String fbc

    As String compileOptions

    As Integer activated

End Type

Constructor Compiler(fbc As String, compileOptions As String, activated As Integer)

    This.fbc = fbc

    This.compileOptions = compileOptions

    This.activated = activated

End Constructor



Declare Sub compileDirectory(fbc As String, compileOptions As String, startDir As String, attribute As Integer, runAfterCompilation As Integer = FALSE, deleteExeAfterwards As Integer = FALSE)





'#####################################################

' Configure here

'#####################################################

Dim As String compileOptions = "-g -exx"

Dim As Compiler fbc(0 To ...) = { Type<Compiler>("fbc", compileOptions, TRUE), _ 'default fbc

                                  Type<Compiler>("""\0.91_x86\fbc.exe""", compileOptions, TRUE), _ 'current x86 build

                                  Type<Compiler>("""\0.91_x64\fbc.exe""", compileOptions, TRUE) }  'current x64 build



Dim As String  startDir      = "test\"

Dim As Integer attribute     = fbDirectory Or fbNormal

Dim As Integer runExe        = TRUE

Dim As Integer deleteExe     = TRUE

'#####################################################





'Output

Print "-------------------------------------------------------------------------------"

Print "| Starting...                                                                 |"

Print "-------------------------------------------------------------------------------"

For i As Integer = 0 To UBound(fbc)

    If fbc(i).activated Then

        Print "Using " & fbc(i).fbc

        Print String(Len(fbc(i).fbc) + Len("Using "), "-")

        compileDirectory(fbc(i).fbc, fbc(i).compileOptions, startDir, attribute, runExe, deleteExe)

        Print "-------------------------------------------------------------------------------"

    EndIf

Next

Print "-------------------------------------------------------------------------------"

Print "| Finished!                                                                   |"

Print "-------------------------------------------------------------------------------"



While Len(InKey) : Wend

Print "Press any key..."

Sleep



Sub compileDirectory(fbc As String, compileOptions As String, startDir As String, attribute As Integer, runAfterCompilation As Integer = FALSE, deleteExeAfterwards As Integer = FALSE)

    Dim As String currName, temp

    Dim As Integer lines, FF, attributeRet



    currName = Dir(startDir & "*", attribute, @attributeRet)



    While currName <> ""

        Select Case attributeRet

            Case fbDirectory

                If currName <> "." AndAlso currName <> ".." Then

                    compileDirectory(fbc, compileOptions, startDir & currName & "\", attribute, runAfterCompilation, deleteExeAfterwards)

                    'reset dir - may cost time in huge folders but will do the trick in most cases

                    Dim As String tempName = Dir(startDir & "*", attribute, @attributeRet)

                    While tempName <> currName

                        tempName = Dir("", attribute, @attributeRet)

                    Wend

                EndIf

            Case Else

                Dim As String fileNameWithoutExtension = Left(currName, Len(currName) - 4)

                Dim As String fileExtension = Mid(currName, InStrRev(currName, "."))

                Dim As String fileNameExe

                #If Defined(__FB_LINUX__)

                    fileNameExe = fileNameWithoutExtension

                #ElseIf Defined(__FB_WIN32__)

                    fileNameExe = fileNameWithoutExtension & ".exe"

                #EndIf

                If fileExtension = ".bas" Then

                    Print "Compiling " & startDir & currName & "..."

                    Dim As String temp, fbcMessages

                    lines = 0

                    FF = FreeFile

                    Open Pipe fbc & " " & compileOptions & " " & startDir & currName & " 2>&1" For Input As #FF

                        While Not Eof( FF )

                            Line Input #FF, temp

                            fbcMessages &= temp

                        Wend

                        If Len(fbcMessages) Then

                            Print "Compilation failed:"

                            Print fbcMessages

                            Print

                        EndIf

                    Close #FF



                    If runAfterCompilation AndAlso Len(fbcMessages) = 0 Then

                        Print "Running " & fileNameExe & ":"

                        Print String(Len(fileNameExe) + Len("Running ") + 1, "-")

                        Exec(startDir & fileNameExe, "")

                        Print String(Len(fileNameExe) + Len("Running ") + 1, "-")

                    EndIf



                    If deleteExeAfterwards AndAlso Len(fbcMessages) = 0 Then

                        Print "Deleting " & fileNameExe & "..."

                        Select Case Kill(startDir & fileNameExe)

                            Case 1

                                Print "Deleting failed: file does not exist: " & startDir & fileNameExe

                            Case 2

                                Print "Deleting failed: " & startDir & fileNameExe

                        End Select

                    EndIf

                EndIf

        End Select



        currName = Dir("", attribute, @attributeRet)

    Wend

End Sub
Zusätzliche Informationen und Funktionen
Das Code-Beispiel wurde am 19.01.2014 von MOD angelegt.
Die aktuellste Version wurde am 26.01.2014 von MOD gespeichert.
Bearbeiten
Versionen