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 ;