Author: wmb
Date: 2009-12-13 10:59:45 +0100 (Sun, 13 Dec 2009)
New Revision: 1590
Modified:
cpu/x86/pc/olpc/via/assy.fth
cpu/x86/pc/olpc/via/mfgtest.fth
cpu/x86/pc/olpc/via/runin.fth
cpu/x86/pc/olpc/via/smt.fth
ofw/gui/iconmenu.fth
Log:
Via manufacturing tests - big cleanup to simplify running the menu and
sequencing the post-menu activities.
Modified: cpu/x86/pc/olpc/via/assy.fth
===================================================================
--- cpu/x86/pc/olpc/via/assy.fth 2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/assy.fth 2009-12-13 09:59:45 UTC (rev 1590)
@@ -237,12 +237,6 @@
" Response" get-response to response$
;
-: silent-probe-usb ( -- )
- " /" ['] (probe-usb2) scan-subtree
- " /" ['] (probe-usb1) scan-subtree
- report-disk report-net report-keyboard
-;
-
: wired-lan? ( -- flag )
" /usb/ethernet" locate-device if false else drop true then
;
Modified: cpu/x86/pc/olpc/via/mfgtest.fth
===================================================================
--- cpu/x86/pc/olpc/via/mfgtest.fth 2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/mfgtest.fth 2009-12-13 09:59:45 UTC (rev 1590)
@@ -13,6 +13,21 @@
0 value pass?
+: mfg-wait-return ( -- )
+ ." ... Press any key to proceed ... "
+ cursor-off
+ gui-alerts
+ begin
+ key? if key drop refresh exit then
+ mouse-ih if
+ 10 get-event if
+ \ Ignore movement, act only on a button down event
+ nip nip if wait-buttons-up refresh exit then
+ then
+ then
+ again
+;
+
: mfg-test-dev ( $ -- )
restore-scroller
find-device
@@ -25,7 +40,7 @@
false to pass?
red-screen
flush-keyboard
- wait-return
+ mfg-wait-return
else
green-letters
." Okay" cr
@@ -40,7 +55,7 @@
false to pass?
red-screen
flush-keyboard
- wait-return
+ mfg-wait-return
then
cursor-off gui-alerts refresh
flush-keyboard
@@ -79,16 +94,26 @@
flush-keyboard
;
-d# 14 value #mfgtests
+d# 15 value #mfgtests
-: play-item ( -- )
- 5 #mfgtests + 5 do
+: mfg-test-autorunner ( -- ) \ Unattended autorun of all tests
+ 5 #mfgtests + 5 ?do
i set-current-sq
refresh
+ d# 1000 ms
+ run-menu-item
+ pass? 0= ?leave
+ loop
+;
+
+: play-item ( -- ) \ Interactive autorun of all tests
+ 5 #mfgtests + 5 ?do
+ i set-current-sq
+ refresh
d# 200 0 do
d# 10 ms key? if unloop unloop exit then
loop
- doit
+ run-menu-item
pass? 0= if unloop exit then
loop
all-tests-passed
@@ -112,15 +137,9 @@
: switch-item ( -- ) " /switches" mfg-test-dev ;
: leds-item ( -- ) " /leds" mfg-test-dev ;
-: mfgtest-menu ( -- )
+: olpc-menu-items ( -- )
clear-menu
- " Run all non-interactive tests. (Press a key between tests to stop.)"
- ['] play-item play.icon 0 1 selected install-icon
-
- " Exit selftest mode."
- ['] quit-item quit.icon 0 3 install-icon
-
\ " CPU"
\ ['] cpu-item cpu.icon 1 0 install-icon
@@ -173,9 +192,28 @@
['] switch-item ebook.icon 3 4 install-icon
;
-' mfgtest-menu to root-menu
+: full-menu ( -- )
+ olpc-menu-items
+
+ " Run all non-interactive tests. (Press a key between tests to stop.)"
+ ['] play-item play.icon 0 1 selected install-icon
+
+ " Exit selftest mode."
+ ['] quit-item quit.icon 0 3 install-icon
+;
+
+' full-menu to root-menu
' noop to do-title
+: autorun-mfg-tests ( -- )
+ ['] mfg-test-autorunner to run-menu \ Run menu automatically
+ true to diag-switch?
+ ['] olpc-menu-items ['] nest-menu catch drop
+ false to diag-switch?
+ restore-scroller
+;
+
+
\ LICENSE_BEGIN
\ Copyright (c) 2009 Luke Gorrie
\
Modified: cpu/x86/pc/olpc/via/runin.fth
===================================================================
--- cpu/x86/pc/olpc/via/runin.fth 2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/runin.fth 2009-12-13 09:59:45 UTC (rev 1590)
@@ -3,7 +3,7 @@
visible
\ Location of the files containing KA tag data
-: ka-dir$ ( -- adr len ) " http:\\10.1.0.1\ka\" ;
+: ka-dir$ ( -- adr len ) " http:\\10.0.0.1\ka\" ;
: nocase-$= ( $1 $2 -- flag )
rot tuck <> if ( adr1 adr2 len2 )
@@ -12,6 +12,13 @@
caps-comp 0= ( flag )
;
+: .instructions ( adr len -- )
+ cr blue-letters type black-letters cr
+;
+: .problem ( adr len -- )
+ red-letters type black-letters cr
+;
+
\ The Linux-based runin selftests put this file at int:\runin\olpc.fth
\ after they have finished. On the next reboot, OFW thus boots this
\ script instead of int:\boot\olpc.fth . This script either displays
@@ -21,18 +28,19 @@
d# 20 buffer: sn-buf
: sn$ ( -- adr len ) sn-buf count ;
-: try-get-sn ( -- )
+: try-scan-sn ( -- gotit? )
sn-buf 1+ d# 20 accept ( n )
d# 12 <> if
" Wrong length, try again" .problem
- exit
+ false exit
then
sn-buf 1+ " TSHC" comp if
" Must begin with TSHC, try again" .problem
- exit
+ false exit
then
sn-buf 2+ sn-buf 1+ d# 11 move \ Elide the T
d# 11 sn-buf c!
+ true
;
: scan-sn ( -- )
@@ -40,8 +48,8 @@
begin
" Please Input Serial Number ......" .instructions
- try-get-sn
- sn-acquired? until
+ try-scan-sn
+ until
;
: board#$ ( -- adr len )
@@ -65,18 +73,15 @@
" Response" get-response to response$
;
-0 value test-passed?
: show-result-screen ( -- )
- restore-scroller
- clear-screen
- test-passed? if
- ." Selftest passed." cr cr cr
+ pass? if
+ clear-screen
+ ." PASS" cr cr
green-screen
else
- ." Selftest failed." cr cr cr
+ ." FAIL" cr cr
red-screen
then
- d# 2000 ms
;
: put-ascii-tag ( value$ key$ -- )
@@ -118,7 +123,7 @@
put-ascii-tag
;
: show-tag ( value$ -- )
- tag-printable? if ?-null type else wrapped-cdump then
+ $tag-printable? if ?-null type else wrapped-cdump then
;
: do-tag-error ( -- )
\ Don't know what to do here
@@ -140,6 +145,15 @@
then
;
+\ Remove possible trailing carriage return from the line
+: ?remove-cr ( adr len -- adr len' )
+ dup if ( adr len )
+ 2dup + 1- c@ carret = if ( adr len )
+ 1-
+ then
+ then
+;
+
: parse-tags ( adr len -- )
begin dup while ( adr len )
linefeed left-parse-string ( rem$ line$ )
@@ -217,7 +231,7 @@
then
;
-: put-key:value ( value$ key$ -- ) " %s:%s" sprint put-key-line ;
+: put-key:value ( value$ key$ -- ) " %s:%s" sprintf put-key-line ;
: upload-tag ( data$ tag$ -- )
2dup " wp" $= if ( data$ tag$ )
@@ -257,65 +271,10 @@
: final-result ( -- )
final-filename$ open-temp-file
upload-tags
- test-passed? if " PASS" else " FAIL" then " RESULT=" put-key+value
+ pass? if " PASS" else " FAIL" then " RESULT=" put-key+value
" Result" submit-file
;
-: finish-final-test ( -- )
- show-result-screen
-
- test-passed? 0= if
- ." Type a key to power off "
- key drop cr power-off
- then
-
- wait-lan
- wait-scanner
-
- get-info
-
- verify-rtc-date
-
- ." Getting final tags .. "
- cifs-connect final-tag-exchange cifs-disconnect
- ." Done" cr
-
- inject-tags
-
- cifs-connect final-result cifs-disconnect
- \ " int:\runin\olpc.fth" $delete-all
-
- \ Ultimately this should just be delete of runin\olpc.fth
- " int:\runin\olpc.fth" " int:\runin\final.fth" $rename
-
- ." Powering off ..." d# 2000 ms
- power-off
-;
-
-d# 15 to #mfgtests
-
-: final-tests ( -- )
- 5 #mfgtests + 5 do
- i set-current-sq
- refresh
- d# 1000 ms
- doit
- pass? 0= if false to test-passed? finish-final-test unloop exit then
- loop
- true to test-passed? finish-final-test
-;
-
-\ Make the "wait for SD insertion" step highly visible
-dev ext
-warning @ warning off
-: selftest ( -- ) page show-pass selftest ;
-warning !
-dend
-
-\ This modifies the menu to be non-interactive
-: doit-once ( -- ) do-key final-tests ;
-patch doit-once do-key menu-interact
-
: scanner? ( -- flag )
" usb-keyboard" expand-alias if 2drop true else false then
;
@@ -343,6 +302,7 @@
begin d# 1000 ms silent-probe-usb usb-key? until
then
;
+
: wait-connections ( -- )
silent-probe-usb
wait-scanner
@@ -350,6 +310,36 @@
\ wait-usb-key
;
+: finish-final-test ( -- )
+ wait-connections
+
+ get-info
+
+ verify-rtc-date
+
+ ." Getting final tags .. "
+ cifs-connect final-tag-exchange cifs-disconnect
+ ." Done" cr
+
+ inject-tags
+
+ cifs-connect final-result cifs-disconnect
+ \ " int:\runin\olpc.fth" $delete-all
+
+ \ Ultimately this should just be delete of runin\olpc.fth
+ " int:\runin\olpc.fth" " int:\runin\final.fth" $rename
+;
+
+\ Make the "wait for SD insertion" step highly visible
+dev ext
+warning @ warning off
+: wait&clear ( -- error? ) wait-card? page ;
+patch wait&clear wait-card? selftest
+: selftest ( -- ) page show-pass selftest ;
+warning !
+dend
+
+
: fail-log-file$ ( -- name$ ) " int:\runin\fail.log" ;
\ The operator can type this to reset the state to run
@@ -367,14 +357,9 @@
key drop cr cr
list
else
-
-\ set-tags-for-fqa
-
- " patch final-tests play-item mfgtest-menu" evaluate
- true to diag-switch?
- menu
- false to diag-switch?
- \ Shouldn't get here because the menu never exits
+ autorun-mfg-tests
+ pass? if finish-final-test then
+ show-result-screen
then
." Type a key to power off"
Modified: cpu/x86/pc/olpc/via/smt.fth
===================================================================
--- cpu/x86/pc/olpc/via/smt.fth 2009-12-12 06:34:50 UTC (rev 1589)
+++ cpu/x86/pc/olpc/via/smt.fth 2009-12-13 09:59:45 UTC (rev 1590)
@@ -125,12 +125,10 @@
get-opid
;
-0 value test-passed?
-
\ Upload the result data
: smt-result ( -- )
smt-filename$ open-temp-file
- test-passed? if " PASS" else " FAIL" then " RESULT=" put-key+value
+ pass? if " PASS" else " FAIL" then " RESULT=" put-key+value
" PROCESS=FVT" put-key-line
" STATION=" put-key-line
" OPID=" put-key-line
@@ -205,7 +203,9 @@
;
\ Decode the server's response and insert appropriate mfg data tags
-: parse-smt-response ( -- )
+: update-tags ( -- )
+ pass? 0= if exit then \ XXX could write a failure log tag
+
." Server responded with: " cr response$ list cr ( )
response$ nip 0= if ." Null manufacturing data" cr exit then
@@ -225,15 +225,14 @@
(put-mfg-data)
no-kbc-reboot
kbc-on
+ else
+ cr cr cr
+ " WARNING: Invalid response from shop floor server - no tags." .problem
+ cr cr cr
+ begin halt again
then
;
-: silent-probe-usb ( -- )
- " /" ['] (probe-usb2) scan-subtree
- " /" ['] (probe-usb1) scan-subtree
- report-disk report-net report-keyboard
-;
-
: scanner? ( -- flag )
" usb-keyboard" expand-alias if 2drop true else false then
;
@@ -277,57 +276,16 @@
;
: show-result-screen ( -- )
- restore-scroller
clear-screen
- test-passed? if
- ." Selftest passed." cr cr cr
+ pass? if
+ ." PASS" cr cr cr
green-screen
else
- ." Selftest failed." cr cr cr
+ ." FAIL" cr cr cr
red-screen
then
- d# 2000 ms
;
-: finish-smt-test ( pass? -- )
- show-result-screen
-
- ." Sending test result "
- cifs-connect smt-result cifs-disconnect
- ." Done" cr
-
- test-passed? if
- ." Writing tags " parse-smt-response ." Done" cr
- then
-
- any-tag? 0= if
- cr cr cr
- " WARNING: Invalid response from shop floor server - no tags." .problem
- cr cr cr
- begin halt again
- then ( )
-
- ." Powering off ..." d# 2000 ms
- power-off
-;
-
-d# 15 to #mfgtests
-
-: smt-tests ( -- )
- 5 #mfgtests + 5 do
- i set-current-sq
- refresh
- d# 1000 ms
- doit
- pass? 0= if false to test-passed? finish-smt-test unloop exit then
- loop
- true to test-passed? finish-smt-test
-;
-
-\ This modifies the menu to be non-interactive
-: doit-once ( -- ) do-key smt-tests ;
-patch doit-once do-key menu-interact
-
: start-smt-test ( -- )
?update-firmware
@@ -341,19 +299,30 @@
." Connecting .. " cifs-connect ." Connected .. "
smt-request$ to response$
cifs-disconnect
- ." Done" cr
+ ." Done" cr
- true to diag-switch?
- " patch smt-tests play-item mfgtest-menu" evaluate
- menu
- false to diag-switch?
+ autorun-mfg-tests
+
+ ." Sending test result "
+ cifs-connect smt-result cifs-disconnect
+ ." Done" cr
+
+ ." Writing tags " update-tags ." Done" cr
+
+ show-result-screen
+
+ ." Type a key to power off"
+ key cr
+ power-off
;
dev /wlan
+warning @ warning off
: selftest ( -- error? )
true to force-open? open false to force-open? ( opened? )
if close false else true then ( error? )
;
+warning !
dend
\ Automatically run the sequence
Modified: ofw/gui/iconmenu.fth
===================================================================
--- ofw/gui/iconmenu.fth 2009-12-12 06:34:50 UTC (rev 1589)
+++ ofw/gui/iconmenu.fth 2009-12-13 09:59:45 UTC (rev 1590)
@@ -284,7 +284,7 @@
highlight describe
;
-: doit ( - )
+: run-menu-item ( - )
current-sq dup valid? if
sq >function @ ?dup if
guarded
@@ -353,7 +353,7 @@
[char] q of menu-done endof
control C of menu-done endof
tab of 1 go-horizontal endof
- carret of doit endof
+ carret of run-menu-item endof
esc of menu-done endof
csi of ( c ) do-csi endof
endcase
@@ -374,7 +374,7 @@
ready? ( buttons was-ready? )
over 0<> to ready? ( buttons was-ready? )
\ Execute the square's function on the button's up transition
- swap 0= and if false to ready? doit then ( )
+ swap 0= and if false to ready? run-menu-item then ( )
else ( buttons new-square )
over 0<> to ready? ( buttons new-square )
dup active? if ( buttons new-square )
@@ -459,6 +459,7 @@
;
headerless
+defer run-menu
: menu-interact ( -- )
default-selection set-current-sq
refresh false to ready?
@@ -470,6 +471,7 @@
remove-mouse-cursor
;
+' menu-interact to run-menu
: setup-graphics ( -- )
?open-screen set-menu-colors ?open-mouse
@@ -490,7 +492,7 @@
['] current-menu behavior current-sq 2>r
- set-menu menu-interact
+ set-menu run-menu
2r> to current-sq set-menu refresh
;
