"{ Package: 'jv:calipel/s' }"

Object subclass:#BenchmarkRunner
	instanceVariableNames:'suite result'
	classVariableNames:''
	poolDictionaries:''
	category:'CalipeL-S-Core-Runner'
!

!BenchmarkRunner class methodsFor:'documentation'!

documentation
"
    BechmarkRunner is the command line client for CalipeL.
    It parses the command line arguments, sets up the
    environment and run benchmarks. 
"
! !

!BenchmarkRunner class methodsFor:'instance creation'!

new
    "return an initialized instance"

    ^ self basicNew initialize.
! !

!BenchmarkRunner methodsFor:'accessing'!

result
    ^ result
!

suite
    ^ suite
! !

!BenchmarkRunner methodsFor:'main'!

main:argv0
    | i report name file params classes runs argv desc setup setupScript teardown teardownScript |

    params := Dictionary new.
    classes := OrderedCollection new.
    report := BenchmarkReport text.
    runs := 5.
    argv := argv0 asOrderedCollection.

    i := 1.
    [ i <= argv size ] whileTrue:[
        | arg |

        arg := argv at: i.
        i := i + 1.
        arg first == $- ifTrue:[
            arg = '-n' ifTrue:[
                i > argv size ifTrue:[
                    self error:'-n requires an integer parameter'
                ].
                runs := Integer readFrom: (argv at: i) onError:[
                    self error: '-n requires an integer parameter'.
                ].
                i := i + 1.
            ].
            arg = '-o' ifTrue:[
                i > argv size ifTrue:[
                    self error:'-o requires a filename parameter'
                ].
                file := argv at: i.
                i := i + 1.
            ].
            (arg = '--arguments' or:[arg = '--script']) ifTrue:[
                | arguments argumentsF |

                i > argv size ifTrue:[
                    self error: arg, ' requires a file parameter.'
                ].                
                argumentsF := (arguments := (argv at: i)) asFilename.
                argumentsF exists ifFalse:[
                    self error:'no such file: ', arguments.
                ].
                argumentsF readingFileDo:[:f | self parseArguments: f into: argv ].
                i := i + 1.
            ].  
                         

            arg = '-r' ifTrue:[
                | reportNm |

                i > argv size ifTrue:[
                    self error:'-r requires a valid class name parameter'
                ].
                reportNm := (argv at: i).
                i := i + 1.
                report := Smalltalk at: reportNm asSymbol.
                report isNil ifTrue:[
                    self error: 'No report class named ''', reportNm, ''''.
                ].
            ].
            arg = '--text' ifTrue:[
                report := BenchmarkReport text.
            ].

            arg = '--json' ifTrue:[
                report := BenchmarkReport json.
            ].

            arg = '--tag' ifTrue:[
                i > argv size ifTrue:[
                    self error:'--tag requires a string parameter.'
                ].                
                name := argv at: i.
                i := i + 1.
            ].

            arg = '--setup' ifTrue:[ 
                i > argv size ifTrue:[
                    self error:'--setup requires a string parameter.'
                ].                
                setup := argv at: i.
                i := i + 1.     
            ].
            arg = '--teardown' ifTrue:[ 
                i > argv size ifTrue:[
                    self error:'--teardown requires a string parameter.'
                ].                
                teardown := argv at: i.
                i := i + 1.     
            ].

            (arg = '--setup-script') ifTrue:[
                i > argv size ifTrue:[
                    self error: arg, ' requires a file parameter.'
                ].                
                setupScript := (argv at: i) asFilename.
                setupScript exists ifFalse:[
                    self error:'no such file: ', (argv at: i).
                ].
                i := i + 1.
            ].  
            (arg = '--teardown-script') ifTrue:[
                i > argv size ifTrue:[
                    self error: arg, ' requires a file parameter.'
                ].                
                teardownScript := (argv at: i) asFilename.
                teardownScript exists ifFalse:[
                    self error:'no such file: ', (argv at: i).
                ].
                i := i + 1.
            ].  



            arg = '--description' ifTrue:[
                i > argv size ifTrue:[
                    self error:'--description requires a string parameter.'
                ].                
                desc := argv at: i.
                i := i + 1.
            ].    

            arg second = $D ifTrue:[
                | eqIdx |

                ((arg size > 2) and:[(eqIdx := arg indexOf: $= startingAt: 3) ~~ 0]) ifTrue:[
                    params at: (arg copyFrom: 3 to: eqIdx - 1) put: (arg copyFrom: eqIdx + 1)
                ] ifFalse:[
                    self error: 'No parameter value'
                ]
            ]
        ] ifFalse:[
            classes add: arg.
        ]
    ].


    classes isEmpty ifTrue:[
        self error:'No suite or benchmark specified.'
    ].

    "Build suite"
    suite := BenchmarkSuite new.
    classes do:[:each|
        | classNm class selector |    
        i := each indexOf: $#.
        i ~~ 0 ifTrue:[
            classNm := each copyTo: i - 1.
            selector := (each copyFrom: i + 1) asSymbol.
        ] ifFalse:[
            classNm := each.
        ].
        class := Smalltalk at: classNm asSymbol.
        class isNil ifTrue:[
            self error: 'Class ', classNm , ' does not exists'.
        ].
        Smalltalk isSmalltalkX ifTrue:[
            class isLoaded ifFalse:[class autoload].
        ].
        selector isNil ifTrue:[
            suite addBenchmark: (BenchmarkSuite class: class)
        ] ifFalse:[
            suite addBenchmark: (BenchmarkSuite class:class selector:selector)
        ]
    ].

    "Run setup, if any"
    setup notNil ifTrue:[ Compiler evaluate: setup ].
    setupScript notNil ifTrue:[ Compiler evaluate: setupScript asFilename contents asString ].

    "Run suite"
    result := BenchmarkResult new.
    result runs: runs.
    suite run: result with: params executor: BenchmarkRunnerExecutor new.

    "Write report"
    file notNil ifTrue:[
        file asFilename writingFileDo:[:s|
            report
                name: name;
                description: desc;      
                write: result on: s 
        ]
    ] ifFalse:[
        report
            name: name;
            description: desc;
            write: result on: BenchmarkPlatform current stdout
    ].

    "Run teardown"
    teardown notNil ifTrue:[ Compiler evaluate: teardown ].
    teardownScript notNil ifTrue:[ Compiler evaluate: teardownScript asFilename contents asString ].

    "Modified: / 08-03-2014 / 16:23:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

options
    "Prints common command line options to stderr"

    BenchmarkPlatform current stderr nextPutAll:
'
Common options:
  -o FILE ................ write output to FILE instead of to standard output (default: stdout)
  -n RUNS ................ how many times to run each bechmark (default: 5)
  -r REPORTCLASS ......... user REPORTCLASS to generate report (default: BenchmarkReportText)
  --arguments FILE ....... read additional arguments from FILE
  --setup EXPR ........... evaluate EXPR before actually running any benchmark
  --setup-script FILE .... evaluate code in FILE before actually running any benchmark
  --teardown EXPR ........ evaluate EXPR after all benchmarks are run
  --teardown-script FILE . evaluate code in FILE  after all benchmarks are run
  --text ................. generate text report (equivalent to -r BenchmarkReportText)
  --json ................. generate JSON report (equivalent to -r BenchmarkReportJSON)
  --tag TAG .............. tag for the current benchmark set (default: "default")
  --description .......... short string describing the current configuration (default: nothing)
  -DNAME=VALUE ........... defines a parameter NAME with value of VALUE

Suitespec format:
  <suitespec> is CLASSNAME[#SELECTOR]

More documetation:
  see https://bitbucket.org/janvrany/jv-calipel/wiki/Home

'

    "Created: / 06-06-2013 / 11:01:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-09-2014 / 09:57:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkRunner methodsFor:'private-parsing'!

parseArgument:stream 
    | c |

    [
        c := stream peek.
        c == $#
    ] whileTrue:[
        self parseComment:stream.
        stream skipSeparators.
        stream atEnd ifTrue:[ ^ nil ].
    ].
    c == $\ ifTrue:[
        stream next.
        [
            stream peek == Character space or:[ stream peek == Character tab ]
        ] whileTrue:[ stream next. ].
        stream peek == Character cr ifTrue:[
            stream skipSeparators.
            ^ self parseArgument:stream.
        ] ifFalse:[ ^ '\' ].
    ].
    c == $" ifTrue:[
        ^ self parseQuoted1:stream
    ].
    c == $' ifTrue:[
        ^ self parseQuoted2:stream
    ].
    ^ self parseToken:stream

    "Created: / 08-03-2014 / 11:01:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 15:59:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseArguments: stream into: argv
    [ stream skipSeparators. stream atEnd ] whileFalse:[
        | arg |

        arg := (self parseArgument: stream).
        arg notNil ifTrue:[ argv add: arg ]
    ].

    "Created: / 08-03-2014 / 10:59:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 15:59:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseComment: stream 
    stream nextLine.

    "Created: / 08-03-2014 / 11:18:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseQuoted1:stream
    "Parse string quoted by $" 
    stream next. "/ eat $"
    ^ String streamContents:[:s|
        [ stream peek == $"] whileFalse:[ 
            stream peek == $\ ifTrue:[ 
                stream next.
            ].
            stream atEnd ifTrue:[ 
                self error:'Unterminated string'.
            ].
            s nextPut: stream next.
        ].
        stream next "/ eat $"
    ].

    "Created: / 08-03-2014 / 11:18:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 15:44:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseQuoted2:stream
    "Parse string quoted by $'" 
    stream next. "/ eat $'
    ^ String streamContents:[:s|
        [ stream peek == $'] whileFalse:[ 
            stream atEnd ifTrue:[ 
                self error:'Unterminated string'.
            ].
            s nextPut: stream next.
        ].
        stream next. "/ eat $'       
    ].

    "Created: / 08-03-2014 / 11:18:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 15:44:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseToken: stream
    ^ String streamContents:[:s|
        [ stream atEnd or:[stream peek isSeparator] ] whileFalse:[ 
            s nextPut: stream next.
        ].
    ].

    "Created: / 08-03-2014 / 11:18:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 15:36:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkRunner class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !