| products/sources/formale sprachen/Cobol/Test-Suite/SQL M/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: reportb.cob Sprache: Cobol |
|
||||||
|
* Standard COBOL (file "REPORTB.SCO") calling SQL
* procedures in file "REPORTB.MCO". * EMBEDDED COBOL ("file REPORTB.PCO") **************************************************************** * * COMMENT SECTION * NIST SQL VALIDATION TEST SUITE V6.0 * DISCLAIMER: * This program was written by employees of NIST to test SQL * implementations for conformance to the SQL standards. * NIST assumes no responsibility for any party's use of * this program. * * * WRITTEN BY: J. Sullivan * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * This routine inserts the result value from TESTREPORT into * the T_REQ row and then maps these test/binding/status/result * rows into the report structure R_STRUCTURE. * * A test is run only once, but it is reported in each profile * which requires it. * * This join of T_REQ and R_STRUCTURE is written as an ASCII * file, passfail.dat, for use by the following report program. * A restriction of REPORTFEATURE (only rows needed for the * report) is written as ASCII file heading.dat. * A restriction of TESTCASE (only rows needed for problem * tests) is written as ASCII file testcase.dat. * Interactive SQL reporting is ignored by this program. * * Debugging is turned on by setting debug1 = 1 * **************************************************************** IDENTIFICATION DIVISION. PROGRAM-ID. REPORTB. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT PASSFA ASSIGN TO "passfail.dat". SELECT HEADIN ASSIGN TO "heading.dat". SELECT TESTCA ASSIGN TO "testcase.dat". DATA DIVISION. FILE SECTION. FD PASSFA RECORD CONTAINS 30 CHARACTERS. 01 PASSFA-REC PIC X(30). FD HEADIN RECORD CONTAINS 37 CHARACTERS. 01 HEADIN-REC PIC X(37). FD TESTCA RECORD CONTAINS 73 CHARACTERS. 01 TESTCA-REC PIC X(73). WORKING-STORAGE SECTION. 01 WS-PASSFA. 02 C11 PIC X(4). 02 PIC X VALUE SPACES. 02 C12 PIC X(4). 02 PIC X VALUE SPACES. 02 C13 PIC X(4). 02 PIC X VALUE SPACES. 02 C14 PIC X(3). 02 PIC X VALUE SPACES. 02 C15 PIC X(3). 02 PIC X VALUE SPACES. 02 C16 PIC X(7). 01 WS-HEADIN. 02 C21 PIC X(4). 02 PIC X VALUE "=". 02 C22 PIC X(32). 01 WS-TESTCA. 02 C31 PIC X(4). 02 PIC X VALUE SPACES. 02 C32 PIC X(50). 02 PIC X VALUE SPACES. 02 C33 PIC X(6). 02 PIC X VALUE SPACES. 02 C34 PIC X(10). * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 prog PIC X(6). 01 tpnote PIC X(10). 01 testno PIC X(4). 01 descr PIC X(50). 01 feat1 PIC X(4). 01 feat2 PIC X(4). 01 result PIC X(4). 01 resul7 PIC X(7). 01 bind1 PIC X(3). 01 reqopt PIC X(3). 01 featur PIC X(32). 01 bindmx PIC X(3). 01 bindct PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE. 01 uid PIC X(18). 01 uidx PIC X(18). 01 SQLSTATE PIC X(5). * EXEC SQL END DECLARE SECTION END-EXEC 01 indivt PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQLCODE PIC S9(9) COMP. 01 errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 iii PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 debug1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 bindii PIC S9(9) DISPLAY SIGN LEADING SEPARATE. *date_time declaration 01 TO-DAY PIC 9(6). 01 THE-TIME PIC 9(8). 01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE. PROCEDURE DIVISION. P0. MOVE "HU " TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx * EXEC SQL SELECT USER INTO :uidx FROM HU.ECCO; CALL "SUB1" USING SQLCODE SQLSTATE uidx MOVE SQLCODE TO SQL-COD if (uid NOT = uidx) then DISPLAY "ERROR: User ", uid, " expected. User ", uidx, " - " connected" STOP RUN END-IF DISPLAY "SQL Test Suite, V6.0, Embedded COBOL, reportb.pco" DISPLAY "59-byte ID" DISPLAY "TEd Version #" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY " " DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME MOVE 0 TO errcnt *to debug program, set debug1 = 1 MOVE 0 TO debug1 *to suppress print of Profile P998, set indivt = 0 MOVE 1 TO indivt *set up * EXEC SQL COMMIT WORK; CALL "SUB2" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *We want to verify later, as we write passfail.dat records, * that the binding pattern is cyclic - * as expected by the report program. *For example, every 3rd row is 'PC'. DISPLAY " " DISPLAY "REPORTB step 1: Check BINDING_CLAIMED table." * EXEC SQL SELECT COUNT(*) INTO :bindct * FROM BINDING_CLAIMED * WHERE BINDING1 <> 'SQL'; CALL "SUB3" USING SQLCODE SQLSTATE bindct MOVE SQLCODE TO SQL-COD if (SQLCODE < 0 OR SQLCODE = 100) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR1 Error counting BINDING_CLAIMED rows," DISPLAY " or BINDING_CLAIMED is empty" DISPLAY " or has only one row with value SQL." DISPLAY "This program does not report on Interactive - " SQL." DISPLAY "SQLCODE = ", SQL-COD, " " *Suicide note #1 END-IF * EXEC SQL SELECT MAX(BINDING1) INTO :bindmx * FROM BINDING_CLAIMED * WHERE BINDING1 <> 'SQL'; CALL "SUB4" USING SQLCODE SQLSTATE bindmx MOVE SQLCODE TO SQL-COD if (SQLCODE < 0 OR SQLCODE = 100) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR2 Error selecting MAX(BINDING1) from - " BINDING_CLAIMED." DISPLAY "SQLCODE = ", SQL-COD *Suicide note #2 END-IF * EXEC SQL COMMIT WORK; CALL "SUB5" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *Insert TESTREPORT pass/fail/nogo result into T_REQ *Assign "miss" value for missing results *Assign " " value for NA tests as well as DL and WD tests DISPLAY " " DISPLAY "REPORTB step 2: Merge pass/fail/nogo values from - " TESTREPORT" DISPLAY " into table T_REQ (list of tests - " required)." DISPLAY "This could take a while...." * EXEC SQL UPDATE T_REQ SET RESULT = ' '; CALL "SUB6" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL COMMIT WORK; CALL "SUB7" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL DECLARE T_REQ_CURSOR CURSOR FOR * SELECT TESTNO, BINDING1, REQOPTNA * FROM T_REQ * WHERE BINDING1 <> 'SQL' END-EXEC * EXEC SQL OPEN T_REQ_CURSOR; CALL "SUB8" USING SQLCODE, SQLSTATE MOVE SQLCODE TO SQL-COD . P100. * EXEC SQL FETCH T_REQ_CURSOR INTO :testno, :bind1, :reqopt * ; CALL "SUB9" USING SQLCODE SQLSTATE testno bind1 reqopt MOVE SQLCODE TO SQL-COD if (SQLCODE < 0 OR SQLCODE = 100) then GO TO P199 END-IF if (reqopt = "NA " ) then MOVE " " TO result GO TO P150 END-IF if (reqopt = "DL " OR reqopt = "WD ") then MOVE " " TO result GO TO P150 END-IF * EXEC SQL SELECT DISTINCT RESULT INTO :result * FROM TESTREPORT * WHERE TESTNO = :testno * AND TESTTYPE = :bind1; CALL "SUB10" USING SQLCODE SQLSTATE result testno bind1 MOVE SQLCODE TO SQL-COD if (SQLCODE = 100) then MOVE "miss" TO result GO TO P150 END-IF if (SQLCODE < 0) then GO TO P110 END-IF if (result = "pass") then GO TO P150 END-IF if (result = "fail") then GO TO P150 END-IF if (result = "nogo") then GO TO P150 END-IF MOVE "fail" TO result *Suicide note #3a COMPUTE errcnt = errcnt + 1 DISPLAY " " DISPLAY "#ERR3a Illegal value in TESTREPORT (RESULT) = ", result GO TO P150 . P110. *No suicide note, just get attention with a FAIL DISPLAY " " DISPLAY "#ERR3b Conflicting results for TESTREPORT rows." DISPLAY "The final result is FAIL:" DISPLAY "SQLCODE = ", SQL-COD, " " * EXEC SQL DECLARE ERROR1 CURSOR FOR * SELECT DISTINCT RESULT * FROM TESTREPORT * WHERE TESTNO = :testno * AND TESTTYPE = :bind1 * ORDER BY RESULT END-EXEC * EXEC SQL OPEN ERROR1; CALL "SUB11" USING SQLCODE SQLSTATE testno bind1 MOVE SQLCODE TO SQL-COD . P120. * EXEC SQL FETCH ERROR1 INTO :result; CALL "SUB12" USING SQLCODE SQLSTATE result MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then DISPLAY "FETCH ERROR1 SQLCODE = ", SQL-COD, " " END-IF if (SQLCODE < 0 OR SQLCODE = 100) then GO TO P121 END-IF DISPLAY "TESTNO = ", testno, ", RESULT = ", result, ", - " TESTTYPE = ", bind1 GO TO P120 . P121. * EXEC SQL CLOSE ERROR1; CALL "SUB13" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD MOVE "fail" TO result . P150. *result value has been obtained for this row if (debug1 = 1) then DISPLAY "Updated T_REQ = ", testno, ", ", bind1, ", ", reqopt, ", ", result END-IF * EXEC SQL UPDATE T_REQ SET RESULT = :result * WHERE CURRENT OF T_REQ_CURSOR; CALL "SUB14" USING SQLCODE SQLSTATE result MOVE SQLCODE TO SQL-COD * same as WHERE TESTNO = :testno AND BINDING1 = :bind1; if (SQLCODE < 0 OR SQLCODE = 100) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR4 Failed to UPDATE row ", testno, " ", bind1, " with result ", result *Suicide note #4 END-IF GO TO P100 . P199. if (SQLCODE < 0) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR5 Error reading T_REQ_CURSOR." DISPLAY "SQLCODE = ", SQL-COD, " " *Suicide note #5 END-IF * EXEC SQL CLOSE T_REQ_CURSOR; CALL "SUB15" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL COMMIT WORK; CALL "SUB16" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *Join R_STRUCTURE to T_REQ *and write as ASCII file passfail.dat DISPLAY " " DISPLAY "REPORTB step 3: Write ASCII file passfail.dat." MOVE 0 TO bindii * EXEC SQL DECLARE TESTLIST CURSOR FOR * SELECT DISTINCT C1, P1, R_STRUCTURE.TESTNO, * BINDING1, REQOPTNA, RESULT * FROM R_STRUCTURE, T_REQ * WHERE R_STRUCTURE.TESTNO = T_REQ.TESTNO * AND BINDING1 <> 'SQL' * ORDER BY 1, 2, 3, 4 END-EXEC * EXEC SQL OPEN TESTLIST; CALL "SUB17" USING SQLCODE, SQLSTATE MOVE SQLCODE TO SQL-COD *open ASCII file passfail.dat OPEN OUTPUT PASSFA MOVE 0 TO iii if (debug1 = 1) then DISPLAY "Derived list of test cases:" END-IF . P200. * EXEC SQL FETCH TESTLIST INTO :feat1, :feat2, * :testno, :bind1, :reqopt, :resul7; CALL "SUB18" USING SQLCODE SQLSTATE feat1 feat2 testno bind1 reqopt resul7 MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR6 Error reading TESTLIST cursor." DISPLAY "SQLCODE = ", SQL-COD, " " *Suicide note #6 END-IF if (SQLCODE < 0 OR SQLCODE = 100) then GO TO P202 END-IF *X/Open profiles do not exist for bindings other than PC and PCO if (feat2 NOT = "P210" AND feat2 NOT = "P230") then GO TO P201 END-IF if (bind1 = "PC " OR bind1 = "PCO") then GO TO P201 END-IF MOVE "NA " TO reqopt MOVE " " TO resul7 . P201. *Profile P998, by default prints, but can be suppressed. if (feat1 = "P998" AND indivt = 0) then GO TO P200 END-IF if (resul7 = "miss ") then MOVE "missing" TO resul7 END-IF *Result value has been obtained from TESTREPORT. *Write passfail.dat record. MOVE feat1 TO C11 MOVE feat2 TO C12 MOVE testno TO C13 MOVE bind1 TO C14 MOVE reqopt TO C15 MOVE resul7 TO C16 MOVE WS-PASSFA TO PASSFA-REC IF iii = 0 WRITE PASSFA-REC MOVE 1 TO iii ELSE WRITE PASSFA-REC AFTER ADVANCING 1 LINE END-IF if (debug1 = 1) then DISPLAY feat1, " ", feat2, " ", testno, " ", bind1, " ", reqopt, " ", resul7 END-IF *Verify every nth bind1 value is the max value COMPUTE bindii = bindii + 1 if (bindii NOT < bindct) then MOVE 0 TO bindii if (bind1 NOT = bindmx) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR7 Binding values are not cyclic at - " PASSFAIL row:" DISPLAY "SQLCODE = ", SQL-COD, " " DISPLAY feat1, " ", feat2, " ", testno, " ", bind1 *Suicide note #7 END-IF END-IF GO TO P200 . P202. * EXEC SQL CLOSE TESTLIST; CALL "SUB19" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL COMMIT WORK; CALL "SUB20" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *close ASCII file passfail.dat CLOSE PASSFA *create file heading.dat *pick up names for profile C1 and subprofile P1 DISPLAY " " DISPLAY "REPORTB step 4: Write ASCII file heading.dat." * EXEC SQL DECLARE HEADING_DAT CURSOR FOR * SELECT DISTINCT FEATURE1, FEATURENAME * FROM REPORTFEATURE, R_STRUCTURE * WHERE FEATURE1 = C1 OR FEATURE1 = P1 * ORDER BY FEATURE1 END-EXEC * EXEC SQL OPEN HEADING_DAT; CALL "SUB21" USING SQLCODE, SQLSTATE MOVE SQLCODE TO SQL-COD *open ASCII file heading.dat OPEN OUTPUT HEADIN MOVE 0 TO iii . P601. * EXEC SQL FETCH HEADING_DAT INTO :feat1, :featur; CALL "SUB22" USING SQLCODE SQLSTATE feat1 featur MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR8 Error reading HEADING_DAT cursor." DISPLAY "SQLCODE = ", SQL-COD, " " *Suicide note #8 END-IF if (SQLCODE < 0 OR SQLCODE = 100) then GO TO P602 END-IF MOVE feat1 TO C21 MOVE featur TO C22 MOVE WS-HEADIN TO HEADIN-REC IF iii = 0 WRITE HEADIN-REC MOVE 1 TO iii ELSE WRITE HEADIN-REC AFTER ADVANCING 1 LINE END-IF GO TO P601 . P602. * EXEC SQL CLOSE HEADING_DAT; CALL "SUB23" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL COMMIT WORK; CALL "SUB24" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *close ASCII file heading.dat CLOSE HEADIN *create file testcase.dat *for problem test numbers DISPLAY " " DISPLAY "REPORTB step 5: Write ASCII file testcase.dat." * EXEC SQL DECLARE TESTCASE_DAT CURSOR FOR * SELECT TESTNO, DESCR, PROG, T_NOTE * FROM TESTCASE * WHERE TESTNO IN * (SELECT TESTNO FROM T_REQ * WHERE RESULT = 'fail' OR RESULT = 'miss') * ORDER BY TESTNO END-EXEC * EXEC SQL OPEN TESTCASE_DAT; CALL "SUB25" USING SQLCODE, SQLSTATE MOVE SQLCODE TO SQL-COD *open ASCII file testcase.dat OPEN OUTPUT TESTCA MOVE 0 TO iii . P701. * EXEC SQL FETCH TESTCASE_DAT INTO :testno, :descr, :prog, * :tpnote :indic1; CALL "SUB26" USING SQLCODE SQLSTATE testno descr prog tpnote indic1 MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then COMPUTE errcnt = errcnt + 1 DISPLAY "#ERR9 Error reading TESTCASE_DAT cursor." DISPLAY "SQLCODE = ", SQL-COD, " " *Suicide note #9 END-IF if (SQLCODE < 0 OR SQLCODE = 100) then GO TO P702 END-IF if (indic1 < 0) then MOVE " " TO tpnote END-IF MOVE testno TO C31 MOVE descr TO C32 MOVE prog TO C33 MOVE tpnote TO C34 MOVE WS-TESTCA TO TESTCA-REC IF iii = 0 WRITE TESTCA-REC MOVE 1 TO iii ELSE WRITE TESTCA-REC AFTER ADVANCING 1 LINE END-IF GO TO P701 . P702. * EXEC SQL CLOSE TESTCASE_DAT; CALL "SUB27" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL COMMIT WORK; CALL "SUB28" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *close ASCII file testcase.dat CLOSE TESTCA *Did we get any suicide notes? if (errcnt > 0) then MOVE 0 TO iii PERFORM P50 UNTIL iii > 9 END-IF *========================================================= DISPLAY " " **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements P50. DISPLAY " ***************************************" DISPLAY " **** Do not run the REPORT program. ***" DISPLAY " **** Correct ", errcnt, " errors and rerun! - " ****" DISPLAY " ***************************************" ADD 1 TO iii . ¤ Dauer der Verarbeitung: 0.8 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
