REBOL [
  Title: "Tester"
  Author: ["Henrik Mikael Kristensen"]
  Copyright: "2006 - HMK Design"
  Filename: %tester.r
  Version: 0.0.11
  Created: 03-Feb-2006
  Date: 16-Jan-2007
  License: {
    BSD (www.opensource.org/licenses/bsd-license.php)
    Use at your own risk.
  }
  Purpose: {
    Standardized test system to load REBOL scripts and run functions
    from them.
    The input and output can be sequenced and recorded for later analysis.
    The tool require list-view.r and toolbar.r
  }
  History: []
]

; ---------- Tester Context

words: copy []

layouts: [
  variable-list [
    styles testerstyle
    space 2 origin 4
    watch-list: list-view with [
      data-columns: [Name]
      editable?: true
      finish-edit-action: [save-project]
    ]
    panel [
      across space 2
      btn "Add" [
        watch-list/append-row watch-list/show-edit save-project
      ]
      btn "Remove" [watch-list/remove-row save-project]
      btn "Close" [hide-popup]
    ]
  ]
  function-list [
    styles testerstyle
    space 0 origin 4 across
    lbl 130 right "Search" func-search-fld: fld 150 [
      func-list/set-filter value
      func-list/first-cnt/act
      focus face
    ] clear-btn [clear-face func-search-fld do-face func-search-fld none]
    lbl "Source Code" 500 return
    func-list: list-view 300x400 with [
      data-columns: [Functions]
      data: first system/words
      list-action: [
        either any [empty? data not get-row] [
          clear-face func-area
          limit-sel-cnt
        ][
          limit-sel-cnt
          word: to-word get-row
          set-face func-area
          either not value? word ["undefined"][
            either any [native? get word op? get word action? get word] [
              reform ["native" mold third get word]
            ] [mold get word]
          ]
        ]
      ]
    ]
    func-area: ar 500x400 font-size 11 para [wrap?: true] return
  ]
  file-list [
    styles testerstyle
    space 0 origin 4 across
    lbl "Base Path" 75 base-path: fld 225 return
    watch-file-list: list-view 300x300 with [
      data-columns: [File]
      editable?: true
      finish-edit-action: [save-project]
    ] return
    panel [
      origin 0x2 across space 2
      btn "Add" [watch-file-list/append-row file-list/show-edit save-project]
      btn "Remove" [watch-file-list/remove-row save-project]
      btn "Close" [hide-popup]
    ]
  ]
  main [
    styles testerstyle
    space 2 origin 4 across
    at 0x0
    main-toolbar: toolbar with [
      data-store: [
        run [
          image "Run Test" run-image.png [
            view/new/title center-face layout [
              h3 "Testing... Please wait" p-test: progress gray yellow
            ] "Testing"
            result-pos: result-list/sel-cnt
            unless empty? code-list/data [
              if config/make-sets [
                sets-list/append-row/values reduce [
                  join "Set " now/time 'none
                ]
              ]
              test code-list/data
              result-list/data: copy results
              if config/make-sets [
                sets-list/change-cell 'result-set copy results
              ]
              result-list/update
              result-list/sel-cnt: result-pos
              result-list/limit-sel-cnt
              result-list/follow
              result-list/do-action 'list-action
              save-project
            ]
            unview
          ]
        ]
        active-project [
          face "Active Project" [
            t-active-project: txt center with [color: none]
              "No project active"
              font-size 11 150 bold [
              face/text: project-list/get-cell 'name
              show face
            ]
          ]
        ]
        projects [
          image "Projects" project.png [
            inform/title center-face project-window "Project List"
          ]
        ]
        filewatch [
          image "File Watch" unknown.png [
            if project-list/sel-cnt [
              inform/title file-list "Watch Files"
              watch-file-list/update
            ]
          ]
        ]
        tests [
          image "Tests" test.png [
            if project-list/sel-cnt [
              view/new/title center-face test-list "Test List"
              code-list/first-cnt/act
              code-list/update
            ]
          ]
        ]
        gen-source [
          image "Source" rsource.png [
            set-face source-area generate-source
            set-face source-config-pnl/pane/2 config/gen-code/includes
            set-face source-config-pnl/pane/3 config/gen-code/header
            set-face source-config-pnl/pane/4 config/gen-code/comments
            set-face source-config-pnl/pane/5 config/gen-code/disabled
            inform/title source-window "Source Code"
          ]
        ]
        functions [
          image "Functions" functions.png [
            view/new/title center-face function-list "Functions List"
            func-list/update
          ]
        ]
        information [
          image "Information" info.png [
            inform/title center-face information-window "Tester Information"
          ]
        ]
        copyentry [
          image "Copy Entry" unknown.png [
            write clipboard:// mold result-list/get-row
          ]
        ]
        help [
          image "Help" unknown.png [
            browse http://www.hmkdesign.dk/rebol/tester/docs/tester.html
          ]
        ]
        console [image "Console" console.png [halt]]
        quit [
          image "Quit" quit.png [if request/confirm "Quit?" [unview/all]]
        ]
      ]
      data: [
        run
;        information
        spacer
        divider
        projects
        active-project
        divider
        tests
        functions
        gen-source
        spacer
        help
        copyentry
        console
        quit
      ]
      frame-padding: 2
    ]
    return
    pad 0x2
    panel [
      space 0
      sets-list: list-view 120x600 with [
        data-columns: [set-name result-set]
        viewed-columns: [set-name]
        header-columns: ["Sets"]
        list-action: [
          result-list/data: get-cell 'result-set
          result-list/update
        ]
        editable?: true
      ] return
      result-list: list-view 500x600 with [
        data-columns: [
          ID Stage Code Type Intended Result Status Variables Files
          Marks Marklist Group-ID
        ]
        allow-sorting: false
        truncate: true
        spacing: 1x0
        viewed-columns: [Stage ID Code Intended Marks Status]
        resize-column: 'Code
        widths: [45 40 100 75 50 50]
        list-action: [
          unless empty? data [
            set-face detail-code get-cell 'code
            area-redrag detail-code-scroller detail-code
            set-face detail-result trim/with mold get-cell 'result {"^{^}}
            area-redrag detail-result-scroller detail-result
            set-face detail-status get-cell 'status
            detail-watch/data: any [get-cell 'variables copy []]
            detail-watch/update
            detail-marks/data: any [get-cell 'marklist copy []]
            detail-marks/update
          ]
        ]
        doubleclick-list-action: [
          view/new/title center-face test-list "Test List"
          code-list/set-sel-cnt result-list/sel-cnt
          code-list/update
          code-list/follow
          code-list/do-action 'list-action
          code-list/update
        ]
        row-action: [
          cell/font/color: switch/default status [
            "OK" [0.80.0]
            "Error" [red]
          ][
            either find [comment break] type [white][black]
          ]
          cell/font/style: either any [
            "Error" = status
            find [comment break] type
          ] ['bold][none]
          switch/default type [
            comment [
              cell/color: sky * either row = sel-cnt [0.7][0.5]
              cell/font/shadow: 1x1
              cells/intended/text:
              cells/marks/text: none
            ]
            break [
              cells/stage/effect: compose/deep [
                draw [
                  pen 0.0.0
                  fill-pen red
                  translate (cells/stage/size / 2 - 6)
                  circle 6x6
                ]
              ]
            ]
          ][
            cell/font/shadow: none
          ]
          cells/stage/color: either stage [stage][white]
          cells/stage/text: none
        ]
      ] return
      details: panel [
        style copy-btn button
          edge [size: 1x1] 40x20 "Copy"
          font [size: 11 color: 0.0.0]
        style full-btn copy-btn "Full" 30
        space 0 across
        lbl "Testcode" 180 copy-btn 50 "Edit..." [
          result-list/do-action 'doubleclick-list-action
        ] full-btn [
          variable-viewer detail-code
          area-redrag variable-data-scroller variable-data
        ] copy-btn [
          write clipboard:// get-face detail-code
        ] return
        detail-code: ar 280x55
        detail-code-scroller: scroller 20x55 [
          scroll-para detail-code detail-code-scroller
        ]
        return
        lbl "Result" 230 full-btn [
          variable-viewer detail-result
          area-redrag variable-data-scroller variable-data
        ] copy-btn [
          write clipboard:// get-face detail-result
        ] return
        detail-result: ar 280x125 para [wrap?: true]
        detail-result-scroller: scroller 20x125 [
          scroll-para detail-result detail-result-scroller
        ]
        return
        lbl "Status" 50 detail-status: fld 250x20 return
        lbl "Watched Variables" 155
        copy-btn 75 "Watch..." [
          if project-list/sel-cnt [
            inform/title variable-list "Watch Variables"
            watch-list/update
          ]
        ] full-btn [
          detail-watch/do-action 'doubleclick-list-action
        ] copy-btn [
          write clipboard:// get-face detail-watch
        ] return
        detail-watch: list-view 300x180 with [
          data-columns: [Name Type Length Contents]
          widths: [100 50 50 100]
          resize-column: 'contents
          spacing: 1x0
          doubleclick-list-action: [
            view/new/title layout [
              styles testerstyle
              space 2 origin 4 across
              h3 (join "Name:" get-cell 'name) pad 20
              h3 (join "Type:" get-cell 'type) pad 20
              h3 (join "Length:" get-cell 'length) return
              ar (get-cell 'contents) 500x700 font-size 11
            ] "Watched Variable"
          ]
          row-action: [
            if column = 'contents [
              if all [string? contents find contents newline] [
                cells/contents/text:
                  join
                    copy/part
                      cells/contents/text
                      index? back find cells/contents/text newline
                    " ..."
              ]
            ]
          ]
        ] return
        lbl "Function Marks" 230 full-btn [
          detail-marks/do-action 'doubleclick-list-action
        ] copy-btn [
          write clipboard:// get-face detail-marks
        ] return
        detail-marks: list-view 300x140 with [
          data-columns: [Mark Probed]
          widths: [40 100]
          resize-column: 'probed
          spacing: 1x0
          doubleclick-list-action: [
            view/new/title layout [
              space 2 origin 4
              styles testerstyle
              h3 (join "Mark:" get-cell 'mark)
              ar (mold get-cell 'probed) 500x700 font-size 11
            ] "Marked Variable"
          ]
          ; ---------- For some reason Rebol crashes when this is active
          row-action: [
            if column = 'probed [
              if all [string? probed find probed newline] [
                cells/probed/text:
                  join
                    copy/part
                      cells/probed/text
                      index? back find cells/probed/text newline
                    " ..."
              ]
            ]
          ]
        ]
      ]
    ] return
    panel [
      space 2 across
      b-make-sets: tog 69 230.230.200 "Make Sets" [
        config/make-sets: value save-config
      ]
      b-remove-set: btn 49 230.230.200 "Delete" [
        sets-list/remove-row/act
        save-project
      ]
      btn "Go up" 60 [
        result-list/prev-cnt/act
      ]
      btn "Go down" 60 [
        result-list/next-cnt/act
      ]
      btn "Next Error" 85 [
        result-list/do-action 'list-action
      ]
      btn "Previous Error" 85 [
        result-list/do-action 'list-action
      ]
      status-text: text right 500
    ]
  ]
  source-window [
    styles testerstyle
    space 0 origin 0
    panel [
      space 2 origin 4 across
      source-area: ar 580x400
      pad -2
      scroll-source-area: scroller 20x400 [
        scroll-para source-area scroll-source-area
      ]
      return
      source-config-pnl: panel [
        space 2 origin 0 across
        box 60x20 "Display:" right font [
          size: 11 shadow: none color: black style: none
        ]
        tog 75x20 "Includes" [
          config/gen-code/includes: face/data
          set-face source-area generate-source
          save-config
          show source-area
        ]
        tog 75x20 "Header" [
          config/gen-code/header: face/data
          set-face source-area generate-source
          save-config
          show source-area
        ]
        tog 75x20 "Comments" [
          config/gen-code/comments: face/data
          set-face source-area generate-source
          save-config
          show source-area
        ]
        tog 75x20 "Disabled" [
          config/gen-code/disabled: face/data
          set-face source-area generate-source
          save-config
          show source-area
        ]
      ]
    ]
    button-bar 608 with [
      append data-store [
        clipboard-btn [
          button "To Clipboard" 100 [write clipboard:// source-area/text]
        ]
        save-btn [
          button "Save Source" 100 [
            if all [f: request-file/save block? f first f] [
              write/binary first f source-area/text
            ]
          ]
        ]
      ]
      data: [save-btn clipboard-btn spacer close-btn]
    ]
  ]
  project-window [
    styles testerstyle
    space 0 origin 0
    panel [
      across space 2 origin 4
      panel [
        across space 2
        project-list: list-view 200x300 with [
          data-columns: [name filename]
          viewed-columns: [name]
          header-columns: ["Projects"]
          editable?: true
          list-action: [
            either sel-cnt [
              include-list/focus-list
              do-face t-nof-results none
              all [value? 't-active-project do-face t-active-project none]
              load-project get-cell 'filename
              config/last-project: get-cell 'name
              save-config
            ][
              all [value? 't-active-project clear-face t-active-project]
              clear-face f-project-file
              clear-face f-basedir
              include-list/data: copy []
              include-list/update
            ]
          ]
          finish-edit-action: [
            hide-edit
            project/projectname: get-cell 'name
            project-list/do-action 'list-action
            save-project
            save-config
          ]
        ] return
        btn 99 "Add Project" [
          project: make project-object [
            filename: to-file join "tester_" trim/with to-string now "-/:+"
          ]
          project-list/append-row/values reduce [
            "Untitled Project" project/filename
          ]
          project-list/show-edit
          update-toolbar
          save-project
          save-config
        ]
        btn 99 "Remove Project" [
          if all[
            project-list/sel-cnt
            request/confirm
              "WARNING! This will erase all test data for this project. The file will not be deleted."
          ] [
            project-list/remove-row/no-select/act
            update-toolbar
            save-config
          ]
        ] return
        btn 99 "Add From File" [
          if f: first request-file [
            load-project f
            project-list/append-row/values reduce [
              project/projectname f
            ]
            update-toolbar
            save-config
          ]
        ]
      ]
      panel [
        across space 2
        text 75 font-size 11 right "Project File" f-project-file: fld 278 [
          either project-list/sel-cnt [
            project/filename: to-url get-face f-project-file
            save-project
          ][clear-face face]
        ] btn "..." 20x20 [
          if project-list/sel-cnt [
            attempt [
              set-face f-project-file request-file
              do-face f-project-file none
              save-project
            ]
          ]
        ] return
        text 75 font-size 11 right "Base Dir" f-basedir: fld 278 [
          either project-list/sel-cnt [
            project/base-dir: to-file get-face face
            save-project
          ][clear-face face]
        ]
        btn "..." 20x20 [
          if project-list/sel-cnt [
            attempt [
              set-face f-basedir request-dir do-face f-basedir none save-project
            ]
          ]
        ]
        return
        text 75 font-size 11 right "Include Files"
        include-list: list-view 300x200 with [
          data-columns: [filename]
          header-columns: ["Included Files"]
          editable?: true
          update?: false
          row-action: [
            
          ]
        ] return
        pad 77
        btn 99 "Add Files..." [
          if project-list/sel-cnt [
            project-list/unfocus-list
            foreach f request-file [
              include-list/append-row/values reduce [f]
            ]
            include-list/update
            save-project
          ]
        ]
        btn 99 "Remove Selected" [
          if project-list/sel-cnt [
            project-list/unfocus-list
            include-list/remove-row
            include-list/update
            save-config
          ]
        ] return
        text 75 font-size 11 right "Result Sets"
        t-nof-results: text 150 font-size 11 bold [
          all [
            object? project in project 'result-set
            face/text: join length? project/results " stored"
            show face
          ]
        ]
      ]
    ]
    button-bar 590 with [data: [spacer close-btn]]
  ]
  test-list [
    styles testerstyle
    space 0 origin 0
    panel [
      space 0 origin 4 across
      code-list: list-view 500x400 with [
        allow-sorting: false
        truncate: true
        redraggable-rows: true
        data-columns: [Stage Entry Type Intended Status]
        viewed-columns: [Stage Entry Intended]
        header-columns: ["Stage" "Entry" "Intended"]
        widths: [45 100 75]
        resize-column: 'entry
        list-action: [
          either any [empty? data not get-row] [
            clear-face code-area
            limit-sel-cnt
          ][
            limit-sel-cnt
            set-face code-area get-cell 'entry
            set-face intended-result-pnl foreach i intended-results [
              append [] either i = get-cell 'intended [true][none]
            ]
          ]
          set-face disabled-line 'disabled = get-cell 'status
          set-face break-line 'break = get-cell 'type
          set-face comment-line 'comment = get-cell 'type
        ]
        drop-action: [save-project save-config]
        row-action: [
          if column = 'stage [
            cells/stage/color: either stage [stage][white]
          ]
          cell/font/color: either status = 'disabled [gray][black]
          any [
            all [
              type = 'comment
              column <> 'stage
              cell/font/color: either 'enabled = status [white][230.230.230]
              cell/font/style: 'bold
              cell/font/shadow: 1x1
              cell/color:
                multiply
                  either 'enabled = status [sky][white]
                  either row = sel-cnt [0.7][0.5]
              any [
                all [
                  column = 'intended
                  cells/intended/text: none 
                ]
                true
              ]
            ]
            all [
              type = 'break
              column = 'stage
              cell/effect: compose/deep [
                draw [
                  pen 0.0.0
                  fill-pen (pick reduce [red gray] status = 'enabled)
                  translate (cell/size / 2 - 6)
                  circle 6x6
                ]
              ]
            ]
            cell/effect: cell/font/style: cell/font/shadow: none
          ]
          cells/stage/text: none
         ; if column = 'entry [
         ;   if find entry newline [
         ;     cells/entry/text:
         ;       join
         ;         copy/part
         ;           cells/entry/text
         ;           index? back find cells/entry/text newline
         ;         " ..."
         ;   ]
         ; ]
        ]
      ]
      panel [
        style copy-btn button
          edge [size: 1x1] 40x20 "Copy"
          font [size: 11 color: 0.0.0]
        space 0 across
        lbl 400 "Stage Colors" return
        style color-btn button 20x20 edge [size: 1x1] [
          code-list/change-cell 'stage face/color
          save-project
        ]
        color-btn black
        color-btn red
        color-btn blue
        color-btn green
        color-btn cyan
        color-btn orange
        color-btn yellow
        color-btn pink
        color-btn sky
        color-btn gray return
        lbl "Code" 300
        copy-btn 60 "Clean Up" [
          replace/all code-area/text "^M" newline
          replace/all code-area/text to-char 202 " " ; alt-space on MacOSX
          do-face code-area none
          code-list/do-action 'list-action
        ]
        copy-btn [write clipboard:// code-area/text] return
        code-area: ar 380x296 [
          code-list/change-cell 'entry reduce [get-face face]
          code-list/update
          save-config
          save-project
        ]
        scroll-code-area: scroller 20x296 [
          scroll-para code-area scroll-code-area
        ]
        return
        lbl 400 "Intended Result" return
        intended-result-pnl: panel [
          style tgl tog font-size 10 [
            code-list/change-cell 'intended face/text save-config
          ] of 'intended
          origin 2 space -1 across
          tgl intended-results/1 true
          tgl intended-results/2
          tgl intended-results/3
          tgl intended-results/4
          tgl intended-results/5
          tgl intended-results/6
          tgl intended-results/7
          tgl intended-results/8
        ]
      ] return
      panel [
        origin 0x2 across space 2
        disabled-line: tog yellow "Disabled" [
          code-list/change-cell/act 'status pick [disabled enabled] face/data
          save-project
          save-config
        ]
        comment-line: tog yellow "Comment" [
          code-list/change-cell/act 'type
            pick reduce ['comment none] face/data
          save-project
          save-config
        ]
        break-line: tog yellow "Break" [
          code-list/change-cell/act 'type pick reduce ['break none] face/data
          save-project
          save-config
        ]
        pad 5
        btn "Add Line" [
          code-list/append-row/act
          code-list/change-cell 'intended "Ignore"
          code-list/change-cell 'status 'enabled
          focus code-area
          save-project
          save-config
        ]
        btn "Insert" [
          code-list/insert-row/act
          code-list/change-cell 'intended "Ignore"
          code-list/change-cell 'status 'enabled
          focus code-area
          save-project
          save-config
        ]
        btn "Remove" [
          code-list/remove-row/act
          save-project
          save-config
        ]
        btn "Copy" [
          code-list/append-row/values/act
          code-list/get-row
          save-project
          save-config
        ]
        btn "Copy Below" [
          code-list/insert-row/values
          code-list/get-row
          code-list/next-cnt/act
          save-project
          save-config
        ]
        ;pad 5
        ;btn "Up" [
        ;  code-list/move-row-up
        ;  save-project
        ;  save-config
        ;]
        ;btn "Down" [
        ;  code-list/move-row-down
        ;  save-project
        ;  save-config
        ;]
      ]
    ]
    button-bar 908 with [
      append data-store [
        window-close-btn [
          button "Close" 100 [unview]
        ]
      ]
      data: [spacer window-close-btn]
    ]
  ]
  information-window [
    styles testerstyle
    space 0 origin 0 below
    panel [
      space 0 origin 4 across
      lbl 250 "Memory stats" return
    ]
    button-bar 258 with [data: [spacer close-btn]]
  ]
]

; ---------- Get local variables for layouts

set-words: function [
  {Get all set-words from a block}
  block [block!]
] [elem bl words] [
  words: make block! length? block
  parse block [
    any [
      set elem set-word! (
        insert tail words :elem
      ) | set bl block! (
        insert tail words set-words bl
      ) | skip
    ]
  ]
  words
]

foreach l layouts [
  if block? l [
    append words head set-words l
  ]
]

append words none

ctx-tester: append words [
  flash "Starting Tester..."
  wait 0.01
  os: any [
    select [
      "31" "Windows"
      "24" "MacOSX"
      "42" "Linux x86"
      "44" "Linux PPC"
      "71" "NetBSD x86"
      "92" "OpenBSD V3.4"
      "94" "OpenBSD V3.8"
      "01" "Sun Solaris"
    ] join system/version/4 system/version/5
    "Other"
  ]

  ; ---------- Are we running locally or from the internet?
  local?: either any [
    %/c/rebol/tester-tool/ = what-dir
    %/Volumes/c/rebol/tester-tool/ = what-dir
  ] [true][false]

  do-file: func [file [file! url!]] [
    do either exists? file [file][to-file join "../" file]
  ]

  load-image: func [file [file! url!]] [
    load either exists? file [
      file
    ][
      to-file join "../image-library/" file
    ]
  ]

  either local? [
    do-file %list-view/src/0.0.49/list-view.r
    do-file %../toolbar/toolbar.r
    run-image.png: load-image %play.png
    console.png: load-image %console.png
    unknown.png: load-image %unknown.png
    test.png: load-image %test.png
    info.png: load-image %info.png
    functions.png: load-image %attention.png
    project.png: load-image %project.png
    rsource.png: load-image %dot-r.png
    quit.png: load-image %quit.png
  ][
    base-path: http://www.hmkdesign.dk/rebol/tester/
    do-file base-path/../list-view/list-view.r
    do-file base-path/../toolbar/toolbar.r
    run-image.png: load-image base-path/play.png
    console.png: load-image base-path/console.png
    unknown.png: load-image base-path/unknown.png
    test.png: load-image base-path/test.png
    info.png: load-image base-path/info.png
    functions.png: load-image base-path/attention.png
    project.png: load-image base-path/project.png
    rsource.png: load-image base-path/dot-r.png
    quit.png: load-image base-path/quit.png
  ]

  ; ---------- Test Data Structures

  project-object: make object! [
    filename: none
    projectname: "Untitled Project"
    includes: copy []
    sets: copy []
    entries: copy []
    watch: copy []
    watch-files: copy []
    base-dir: none
  ]
  project: none
  
  result-object: make object! [
    results: copy []
  ]
  
  ; ---------- Testing Functions
  
  ; The result output is a block of blocks:
  
  results: copy []
  
  testerstyle: stylize [
    lbl: box 180.180.180 300x20 font [
      align: 'left size: 12 shadow: none color: black
    ]
    ar: area
      font [
        name: any [
          select ["Windows" "Terminal" "MacOSX" "Monaco"] os "Courier"
        ]
        size: any [select ["Windows" 8 "MacOSX" 9] os 8]
      ] edge [size: 1x1] para [wrap?: true]
    fld: field 200x20 font-size 11 edge [size: 1x1]
    clear-btn: button edge [size: 1x1] 20x20 "X"
  ]
  
  area-redrag: func [face face2] [
    face/redrag face2/size/y / max 1 second size-text face2
    show face
  ]

  test: func [
    entries
    /local marklist error monitor-obj monitor-files code run-error val stage
    group-id ret-val
  ] [
    mark: func [
      id /prb value
    ][
      append/only marklist reduce [id either prb [mold :value]["-"]]
      :value
    ]
    ; the test code should return TRUE
    ; unset all watched variables at the start of the test
    unset load form project/watch
    ; it should really reset all variables used inside the test, but we
    ; can't easily see those variables here.
    ; maybe the test can be put inside its own context?
    run-error: error? try [do to-file config/test-code]
    func-list/data: first system/words
    func-list/update
    results: copy []
    stage: none
    warnings: errors: 0
    repeat i length? entries [
      set-face p-test i / length? entries
      wait 0.001 ; otherwise the display does not update
      monitor-files: copy monitor-obj: copy []
      error-obj: none
      code: load load second pick entries i
      stage: first pick entries i
      type: third pick entries i
      status: any [attempt [fifth pick entries i] 'enabled]
      intended: fourth pick entries i
      marklist: copy []
      error: none

      ; ---------- Filling out result list
      group-id: 0
      unset 'ret-val
      if 'enabled = status [
        either 'comment = type [
          insert/only tail results reduce [
            i
            stage
            code
            type
            intended
            type
            copy ""
            monitor-obj
            monitor-files
            length? marklist
            marklist
            group-id: group-id + 1
          ]
        ][
          insert/only tail results reduce either any [

            ; Load first to make sure that the code is loadable
            error? error: try [load first second pick entries i]

            ; Do the code with two try's to catch unset return values
            error? error: try [error: try [do first second pick entries i]]

          ] [
            error-obj: disarm error
            either all [
              error-obj/id = 'need-value
              error-obj/arg1 = to-set-word 'error
            ] [
              ; ---------- Entry did not return a value
              [
                i
                stage
                code
                type
                intended
                "unset!"
                "OK"
                monitor-obj
                monitor-files
                length? marklist
                marklist
                group-id
              ]
            ][
              ; ---------- This is an error
              errors: errors + 1
              [
                i
                stage
                code
                type
                intended
                mold error-obj
                "Error"
                monitor-obj
                monitor-files
                length? marklist
                marklist
                group-id
              ]
            ]
          ][
            ; translating error return variable to useful results
            error: mold get 'error
            [
              i
              stage
              code
              type
              intended
              mold error
              either all [
                intended
                error
                any [not series? intended not empty? intended]
                any [not series? error not empty? error]
                intended = "Ignore"
              ] ["OK"][
                either equal? do intended do error [
                  "OK"
                ][
                  warnings: warnings + 1
                  "Warn"
                ]
              ]
              monitor-obj
              monitor-files
              length? marklist
              marklist
              group-id
            ]
          ]
        ]
        set-face status-text reform [
          errors pick ["error," "errors,"] 1 = errors
          warnings pick ["warning" "warnings"] 1 = warnings
        ]
        ; ---------- Monitoring variables
        foreach v watch-list/data [
          use [val] [
            attempt [val: do first v]
            append/only monitor-obj reduce [
              to-string first v
              either value? 'val [type? val][unset!]
              any [
                all [
                  value? 'val
                  any [
                    series? val
                    port? val
                    tuple? val
                    bitset? val
                    struct? val
                  ]
                  length? val
                ]
                copy "-"
              ]
              mold either value? 'val [val][unset!]
            ]
          ]
        ]
        if type = 'break [break]
      ]
    ]
  ]

  ; ---------- Writing out Data

  variable-list: layout bind layouts/variable-list 'self
  file-list: layout bind layouts/file-list 'self

  variable-viewer: func [var /text txt /local t] [
    t: either text [txt]["No description"]
    view/new/title layout [
      styles testerstyle
      origin 4 space 0 across
      btn "Next" [
        result-list/next-cnt/act
        set-face first back back tail face/parent-face/pane get-face var
        area-redrag variable-data-scroller variable-data
      ] pad 2
      btn "Previous" [
        result-list/prev-cnt/act
        set-face first back back tail face/parent-face/pane get-face var
        area-redrag variable-data-scroller variable-data
      ] h4 t return
      pad 0x2 return
      variable-data: ar 500x500 (get-face var)
      variable-data-scroller: scroller 20x500 [
        scroll-para variable-data variable-data-scroller
      ]
    ] "Variable Viewer"
  ]
  
  intended-results: copy [
    "Ignore" "TRUE" "FALSE" "NONE" "Not Error!" "Error!" "Object!" "String!"
  ]
  
  result-pos: 0

  test-list: layout bind layouts/test-list 'self
  function-list: layout bind layouts/function-list 'self
  project-window: layout bind layouts/project-window 'self
  source-window: layout bind layouts/source-window 'self
  information-window: layout bind layouts/information-window 'self
  main: layout bind layouts/main 'self

  update-toolbar: does [
    main-toolbar/size/x: main/size/x
    either empty? project-list/data [
      main-toolbar/disable 'run
      main-toolbar/disable 'tests
      main-toolbar/disable 'copyentry
    ][
      main-toolbar/enable 'run
      main-toolbar/enable 'tests
      main-toolbar/enable 'copyentry
    ]
  ]

  ; ---------- Source Handling
  
  generate-source: has [out c status type entry-idx entry] [
    out: copy ""
    c: config/gen-code
    all [
      c/header
      append out copy {REBOL [title: "Source generated by Tester"]^/^/}
    ]
    all [
      c/includes
      append out copy "; ---------- Includes Start^/^/"
      append out copy "; ---------- Includes End^/^/"
    ]
    status: index? find code-list/data-columns 'status
    type: index? find code-list/data-columns 'type
    entry-idx: code-list/col-idx 'entry
    foreach row code-list/data [
      all [
        any [
          all [c/comments 'comment = pick row type]
          all [c/disabled 'disabled = pick row status]
          all [
            'disabled <> pick row status
            'comment <> pick row type
          ]
        ]
        entry: copy first pick row entry-idx
        either 'comment = pick row type [
          insert entry "; ---------- " true
        ][
          true
        ]
        insert tail out rejoin [form head entry newline newline]
      ]
    ]
    out
  ]

  ; ---------- Settings
  
  config: make object! [
    projects: copy []
    make-sets: false
    gen-code: make object! [
      includes: false
      header: false
      comments: false
      disabled: false
    ]
    config-file: %tester-cfg.r
    last-project: none
  ]
  
  save-project: does [write/binary project/filename mold project]
  
  load-project: func [file [file!]] [
    project: make project-object do load file
    ; ---------- Assign to the proper lists
    code-list/data: project/entries
    code-list/update
    watch-list/data: project/watch
    watch-list/update
    sets-list/data: project/sets
    sets-list/update
    include-list/data: project/includes
    include-list/update
    set-face f-project-file project/filename
    set-face f-basedir project/base-dir
  ]

  save-config: does [write/binary config/config-file mold/all config]

  load-settings: does [
    either exists? config/config-file [
      unless attempt [
        config: make config load to-file config/config-file
      ] [
        alert
          "Configuration file is damaged. Creating a new configuration file."
      ]
    ][save-config config/config-file]
    project-list/data: config/projects
  ;  code-list/data: config/entries
  ;  watch-list/data: config/watch
    set-face b-make-sets config/make-sets
  ;  set-face test-code-fld config/test-code
  ]
  
  delete-settings: does [delete config/config-file]
  
  load-settings
  
  project-list/data: config/projects
  either config/last-project [
    project-list/find-row/col config/last-project 'name
  ][
    project-list/first-cnt
  ]
  project-list/update
  tester: does [
    view/new/title center-face main "Tester Alpha 0.0.11"
    area-redrag detail-result-scroller detail-result
    area-redrag detail-code-scroller detail-code
    update-toolbar
    project-list/do-action 'list-action
    sets-list/last-cnt/act
    do-events
  ]
  unview
]

ctx-tester: context ctx-tester
unset [layouts set-words words]
ctx-tester/tester