/* testrun2.p 2001 by John Green, Joanju Limited This procedure must be run persistently. Parses, and validates the parse, of a program or list of programs. Displays the results out to an edit/window. For each program parsed, if "actionProgram" is not blank, the actionProgram gets run against the parse results. In character mode, the editor "ed1" has a different background color when it is disabled from when it is enabled. This may cause a flicker effect when running a small test set of programs as the editor is enabled and the background color changes, but no information is lost. Methods List ============ main No parameters. Run this once everything is set. getNumErrors OUTPUT INTEGER Get the number of errors after calling "main". getTempFileNames OUTPUT CHARACTER /* temp preprocess output filename */ OUTPUT CHARACTER /* temp parser output filename */ Use this to get the the two temporary filenames, for displaying in error messages etc. setActionProgram INPUT CHARACTER Sets the name of a program to run for each program parsed. actionProgram might be a query that you want to run against the syntax tree. It requires three input parameters: - a HANDLE to the persistent parser procedure - an INTEGER node handle - a CHARACTER program name setDeleteTemps INPUT LOGICAL Set to FALSE if you want the temporary parser output file and preprocessor output file to be left undeleted. setFileList INPUT CHARACTER Sets the name of a file containing a list of program names (.w, .p, etc). One program name per line. Lines can be commented out by inserting lines containing nothing but open comment (/*) and closing comment (*/). setSelfTest INPUT LOGICAL Set to FALSE if you want to disable Test Run's self-test of the parser output against COMPILE..PREPROCESS. setSingle INPUT CHARACTER Alternative to setFileList, for parsing a single program. Input the name of the program file to parse. If setSingle is used, setFileList is ignored. */ DEFINE VARIABLE parserHandle AS HANDLE NO-UNDO. RUN proparse/api/proparse.p PERSISTENT SET parserHandle. {proparse/api/proparse.i parserHandle} DEFINE VARIABLE actionProgram AS CHARACTER NO-UNDO. DEFINE VARIABLE errfile AS CHARACTER NO-UNDO. DEFINE VARIABLE errorMess AS CHARACTER NO-UNDO. DEFINE VARIABLE filelist AS CHARACTER NO-UNDO. DEFINE VARIABLE filename AS CHARACTER NO-UNDO. DEFINE VARIABLE filenshort AS CHARACTER NO-UNDO. DEFINE VARIABLE outfile AS CHARACTER NO-UNDO. DEFINE VARIABLE prefile AS CHARACTER NO-UNDO. DEFINE VARIABLE shortname AS CHARACTER NO-UNDO. DEFINE VARIABLE singleFile AS CHARACTER NO-UNDO. DEFINE VARIABLE commentlevel AS INTEGER NO-UNDO. DEFINE VARIABLE compilerLoopNum AS INTEGER NO-UNDO. DEFINE VARIABLE counter AS INTEGER NO-UNDO. DEFINE VARIABLE edheight AS INTEGER NO-UNDO. DEFINE VARIABLE firstnode AS INTEGER NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. DEFINE VARIABLE indent AS INTEGER NO-UNDO INITIAL -8. DEFINE VARIABLE indentby AS INTEGER NO-UNDO INITIAL 4. DEFINE VARIABLE numErrors AS INTEGER NO-UNDO. DEFINE VARIABLE deleteTemps AS LOGICAL NO-UNDO INITIAL TRUE. DEFINE VARIABLE isError AS LOGICAL NO-UNDO. DEFINE VARIABLE needCompilerStreamIO AS LOGICAL NO-UNDO INITIAL NO. DEFINE VARIABLE needline AS LOGICAL NO-UNDO. DEFINE VARIABLE selfTest AS LOGICAL NO-UNDO INITIAL TRUE. DEFINE VARIABLE singleDone AS LOGICAL NO-UNDO. DEFINE VARIABLE ptr AS MEMPTR NO-UNDO. DEFINE VARIABLE ed1 AS WIDGET-HANDLE NO-UNDO. DEFINE STREAM errStream. FORM WITH FRAME f1 VIEW-AS DIALOG-BOX SIZE 122 BY 27 NO-LABELS THREE-D. ON "CLOSE" OF THIS-PROCEDURE DO: DELETE PROCEDURE THIS-PROCEDURE. END. RETURN. /* Run me persistent! */ PROCEDURE main: ASSIGN errfile = SESSION:TEMP-DIRECTORY + "joanju_testrun_err.txt". ASSIGN outfile = SESSION:TEMP-DIRECTORY + "joanju_testrun_out.txt". ASSIGN prefile = SESSION:TEMP-DIRECTORY + "joanju_testrun_pre.txt". IF SESSION:DISPLAY-TYPE = "TTY" THEN ASSIGN edheight = 22. ELSE ASSIGN edheight = 24. CREATE EDITOR ed1 ASSIGN READ-ONLY = TRUE FRAME = FRAME f1:HANDLE SCROLLBAR-VERTICAL = TRUE SCROLLBAR-HORIZONTAL = TRUE LARGE = TRUE WIDTH = 120 HEIGHT = edheight. DISPLAY WITH FRAME f1. ed1:INSERT-STRING("Press Esc to stop.~n"). IF singleFile = "" THEN INPUT FROM VALUE( SEARCH(filelist)). ASSIGN counter = 0. IF actionProgram <> "" THEN ASSIGN shortname = SUBSTRING(actionProgram, MAX(R-INDEX(actionProgram,"/"), R-INDEX(actionProgram,"~\")) + 1). file-loop: REPEAT ON ERROR UNDO, LEAVE: PROCESS EVENTS. ASSIGN counter = counter + 1. IF singleFile = "" THEN DO: IMPORT UNFORMATTED filename. IF filename = "" THEN NEXT file-loop. END. ELSE DO: IF singleDone THEN LEAVE file-loop. ASSIGN filename = singleFile singleDone = TRUE. END. IF filename = "/*" THEN ASSIGN commentlevel = commentlevel + 1. IF commentlevel = 0 AND filename <> "*/" THEN DO: /* If the filename is very long, * and the whole line gets too long for the EDITOR, then the entire * editor "shifts" right, and it looks ugly - you can't see the line number * anymore. * Using WORD-WRAP doesn't resolve this nicely, because then the editor * doesn't display any text until it has an entire line to write out. */ ed1:INSERT-STRING( "~n" + STRING(counter) + " " + IF LENGTH(filename,"COLUMN") > 50 THEN "..." + SUBSTRING(filename, LENGTH(filename,"COLUMN") - 45, 45, "COLUMN") ELSE filename + (IF selftest THEN " preprocess" ELSE "") ). /* This program doesn't generate or replace r-code, because some * applications require different compile parameters and settings * for different compilable programs. * We compile without save, but that might generate error 6430, * which is the warning that .r-code exists but SAVE was not * specified. Ignore that error number. * (2884 appears to be an old 8.3 variant of the 6430 error) */ compiler-loop: DO compilerLoopNum = 1 TO 2: COMPILE VALUE(filename) STREAM-IO = needCompilerStreamIO PREPROCESS VALUE(prefile) NO-ERROR. IF COMPILER:ERROR AND ( ( ERROR-STATUS:GET-NUMBER(1) <> 6430 AND ERROR-STATUS:GET-NUMBER(1) <> 2884 ) OR ERROR-STATUS:NUM-MESSAGES > 1 ) THEN DO: ASSIGN errorMess = "" isError = false. DO i1 = 1 TO ERROR-STATUS:NUM-MESSAGES: IF ERROR-STATUS:GET-NUMBER(i1) <> 6430 AND ERROR-STATUS:GET-NUMBER(i1) <> 2884 THEN DO: /* 4345 seems to be the error number for &MESSAGEs. * Those aren't errors to Proparse. */ IF ERROR-STATUS:GET-NUMBER(i1) <> 4345 THEN ASSIGN isError = true. ASSIGN errorMess = errorMess + "~n" + ERROR-STATUS:GET-MESSAGE(i1). END. END. /* Flip the STREAM-IO flag. On the first failed compile, it gets flipped. On the second failed compile, we flip it again, so that it's back to its value before we tried this compile unit. */ ASSIGN needCompilerStreamIO = NOT needCompilerStreamIO. IF compilerLoopNum EQ 1 THEN NEXT compiler-loop. ed1:INSERT-STRING("~n" + errorMess + "~n"). IF isError AND NOT COMPILER:WARNING THEN DO: ASSIGN errorMess = filename + " compile failed:~n" + errorMess. RUN errorLogger (errorMess). NEXT file-loop. END. END. END. /* compiler-loop */ ed1:INSERT-STRING(" parse"). IF SEARCH(filename) = ? THEN DO: ASSIGN errorMess = SUBSTITUTE("file &1 not found", filename). ed1:INSERT-STRING("~n" + errorMess + "~n"). RUN errorLogger (errorMess). NEXT file-loop. END. IF parserParse(SEARCH(filename)) = FALSE THEN DO: ASSIGN errorMess = parserErrorGetText(). /* Watch for user Cancel (engine overheated) from Proparse Lite */ IF errorMess = "Proparse Lite: Cancel":U THEN LEAVE file-loop. ed1:INSERT-STRING("~n" + errorMess + "~n"). RUN errorLogger (filename + "~n" + errorMess). NEXT file-loop. END. IF selftest THEN ed1:INSERT-STRING(" write"). ASSIGN firstnode = parserGetHandle(). parserNodeTop(firstnode). /* gets us the "Program_root" node */ parserWriteNode(firstnode, outfile). IF selfTest THEN DO: ed1:INSERT-STRING(" " + "check"). ASSIGN errorMess = parserIwdiff(prefile, outfile). IF errorMess <> "" THEN DO: ASSIGN errorMess = filename + "~n" + errorMess. ed1:INSERT-STRING("~n" + errorMess + "~n"). IF singleFile <> "" AND NOT deleteTemps THEN DO: ed1:INSERT-STRING("See the files:~n"). ed1:INSERT-STRING(prefile + "~n"). ed1:INSERT-STRING(outfile + "~n"). END. RUN errorLogger (errorMess). NEXT file-loop. END. END. ed1:INSERT-STRING(" ok"). IF actionProgram <> "" THEN DO: ed1:INSERT-STRING(" " + shortname). RUN VALUE(actionProgram) (parserHandle, firstnode, filename). IF parserErrorGetStatus() < 0 THEN DO: ASSIGN errorMess = filename + "~n" + parserErrorGetText(). ed1:INSERT-STRING("~n" + errorMess + "~n"). RUN errorLogger (errorMess). END. IF RETURN-VALUE <> "" THEN DO: ASSIGN errorMess = filename + "~n" + RETURN-VALUE. ed1:INSERT-STRING("~n" + errorMess + "~n"). RUN errorLogger (errorMess). END. END. END. IF filename = "*/" THEN ASSIGN commentlevel = commentlevel - 1. END. /* file-loop */ IF singleFile = "" THEN INPUT CLOSE. APPLY "CLOSE" TO parserHandle. IF numErrors = 0 THEN ed1:INSERT-STRING("~n~nThere were no errors.~n"). IF numErrors > 0 AND singleFile = "" THEN ed1:INSERT-STRING("~n~nError logfile will be displayed next.~n"). ed1:INSERT-STRING("~nPress Esc to close.~n"). ENABLE ALL WITH FRAME f1. DO ON ERROR UNDO, LEAVE ON END-KEY UNDO, LEAVE: WAIT-FOR WINDOW-CLOSE OF FRAME f1. END. IF deleteTemps THEN DO: OS-DELETE VALUE(prefile). OS-DELETE VALUE(outfile). END. IF numErrors > 0 AND singleFile = "" THEN DO: PUT STREAM errStream UNFORMATTED SKIP(1) "Number of errors: " numErrors SKIP "Press Esc to close.". OUTPUT STREAM errStream CLOSE. RUN proparse/utilities/resultswindow.p (errfile). END. OUTPUT STREAM errStream CLOSE. RETURN. END PROCEDURE. /* main */ PROCEDURE getNumErrors: DEFINE OUTPUT PARAMETER p AS INTEGER NO-UNDO. ASSIGN p = numErrors. END. PROCEDURE getTempFileNames: DEFINE OUTPUT PARAMETER p1 AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER p2 AS CHARACTER NO-UNDO. ASSIGN p1 = prefile p2 = outfile. END. PROCEDURE errorLogger: DEFINE INPUT PARAMETER theText AS CHARACTER NO-UNDO. IF numErrors = 0 THEN DO: OUTPUT STREAM errStream TO VALUE(errfile). PUT STREAM errStream UNFORMATTED errfile SKIP "Testrun error log". END. ASSIGN numErrors = numErrors + 1. PUT STREAM errStream UNFORMATTED SKIP(1) theText. END PROCEDURE. PROCEDURE setActionProgram: DEFINE INPUT PARAMETER p AS CHARACTER NO-UNDO. ASSIGN actionProgram = p. END PROCEDURE. PROCEDURE setDeleteTemps: DEFINE INPUT PARAMETER p AS LOGICAL NO-UNDO. ASSIGN deleteTemps = p. END PROCEDURE. PROCEDURE setFileList: DEFINE INPUT PARAMETER p AS CHARACTER NO-UNDO. ASSIGN filelist = p. END PROCEDURE. PROCEDURE setSelfTest: DEFINE INPUT PARAMETER p AS LOGICAL NO-UNDO. ASSIGN selfTest = p. END PROCEDURE. PROCEDURE setSingle: DEFINE INPUT PARAMETER p AS CHARACTER NO-UNDO. ASSIGN singleFile = p. END PROCEDURE.