"{ 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

    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.

    "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 ].

!

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)

  --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>"

! !

!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> $'

! !