Changeset 2998

Timestamp:

Jun 2, 2012 12:02:39 PM (12 months ago)

Author:

quozl

Message:

OLPC - test menu, automatic tests; maintain an overall failure state and report it at the end, handle any escape request from the hold message, make the quit item the default afterwards, and provide the timed menu again. #11847.

File:

• cpu/x86/pc/olpc/via/mfgtest.fth (modified) (8 diffs)

cpu/x86/pc/olpc/via/mfgtest.fth

@@ -32 +32 @@
 
 0 value pass?
+0 value overall-fail?
+0 value stop?
 
 : mfg-wait-return  ( -- )
@@ -53 +55 @@
          ??cr ." Selftest failed. Return code = " .d cr
          mfg-color-red sq-border!
-         false to pass?
+         false to pass?  true to overall-fail?
          red-screen
          flush-keyboard
@@ -63 +65 @@
          mfg-color-green sq-border!
          true to pass?
-         d# 2000 hold-message drop
+         d# 2000 hold-message  if  true to stop?  then
       then
    else
       ??cr ." Selftest failed due to abort"  cr
       mfg-color-red sq-border!
-      false to pass?
+      false to pass?  true to overall-fail?
       red-screen
       flush-keyboard
@@ -96 +98 @@
 ;
 
-: all-tests-passed  ( -- )
+: overall  ( -- )
    restore-scroller-bg
    clear-screen
-   ." All automatic tests passed successfully." cr cr cr
-   green-screen
+   overall-fail?  if
+      ." Some tests failed." cr cr cr
+      red-screen
+   else
+      ." All automatic tests passed successfully." cr cr cr
+      green-screen
+   then
    wait-return
    cursor-off  scroller-off  gui-alerts  refresh
@@ -141 +148 @@
 
 : play-item     ( -- )   \ Interactive autorun of all tests
+   false to overall-fail?
+   false to stop?
    #mfgcols #mfgtests +  #mfgcols  ?do
       i set-current-sq
@@ -148 +157 @@
       loop
       run-menu-item
-      pass? 0= if  unloop exit  then
+      stop?  if unloop exit  then
    loop
-   all-tests-passed
-;
-
-: quit-item     ( -- )  menu-done  ;
+   0 3 rc>sq set-current-sq \ quit-item
+   overall
+;
+
+false value quit?
+: quit-item     ( -- )  true to quit?  menu-done  ;
 
 : init-menu  ( -- )
@@ -197 +208 @@
 ;
 
-: autorun-from-gamekey  ( -- )
-   default-selection set-current-sq refresh
+: pause-to-interact
+   refresh
    (cr kill-line
    0  d# 30  do
@@ -206 +217 @@
          drop                          ( )
          menu-interact                 ( )
+         true to quit?
          unloop exit                   ( -- )
       then                             ( )
       d# 100 ms                        ( )
    -1 +loop
+;
+
+: autorun-from-gamekey  ( -- )
+   false to quit?
+   default-selection set-current-sq
+   pause-to-interact
+   quit?  if  exit  then
    play-item
-;
+   stop?  if  menu-interact exit  then
+   quit?  if  exit  then
+   0 3 rc>sq set-current-sq \ quit-item
+   pause-to-interact
+;
+
 : gamekey-auto-menu  ( -- )
    ['] run-menu behavior >r