|
* 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).
01 SQLCODE PIC S9(9) COMP.
EXEC SQL END DECLARE SECTION END-EXEC
01 indivt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
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 END-EXEC
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 END-EXEC
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' END-EXEC
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' END-EXEC
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 END-EXEC
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 RESULT2 = ' ' END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
.
P100.
EXEC SQL FETCH T_REQ_CURSOR INTO :testno, :bind1, :reqopt
END-EXEC
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 RESULT2 INTO :result
FROM TESTREPORT
WHERE TESTNO = :testno
AND TESTTYPE = :bind1 END-EXEC
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 RESULT2
FROM TESTREPORT
WHERE TESTNO = :testno
AND TESTTYPE = :bind1
ORDER BY RESULT2 END-EXEC
EXEC SQL OPEN ERROR1 END-EXEC
MOVE SQLCODE TO SQL-COD
.
P120.
EXEC SQL FETCH ERROR1 INTO :result END-EXEC
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 END-EXEC
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 RESULT2 = :result
WHERE CURRENT OF T_REQ_CURSOR END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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, RESULT2
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 END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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 RESULT2 = 'fail' OR RESULT2 = 'miss')
ORDER BY TESTNO END-EXEC
EXEC SQL OPEN TESTCASE_DAT END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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.16 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.
|
