|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei:
dml056.mco
Sprache: Unknown
|
|
IDENTIFICATION DIVISION.
PROGRAM-ID. YTS806.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "YTS806.SCO") calling SQL
* procedures in file "YTS806.MCO".
*Copyright 1996 National Computing Centre Ltd,
*and Computer Logic R&D S.A
*on behalf of CTS5 SQL2 Project.
*All rights reserved.
*The CTS5 SQL2 Project is sponsored by the European Community.
*
*The National Computing Centre Limited and Computer Logic R&D
*have given permission to NIST to distribute this program
*over the World Wide Web in order to promote SQL standards.
*DISCLAIMER:
*This program was reviewed by employees of NIST for
*conformance to the SQL standards.
*NIST assumes no responsibility for any party's use of
*this program.
****************************************************************
*
* COMMENT SECTION
*
* SQL VALIDATION TEST SUITE V6.0
*
* YTS806.SCO
* WRITTEN BY: Susan Watters
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* This routine tests NATURAL FULL OUTER JOIN <table ref> -
* dynamic
*
*
* REFERENCES
* 7.5 <joined table>
* 7.5 SR.6
* 7.5 GR.1d
* 7.5 GR.5d
* 7.5 GR.6a
* 17.1 Description of SQL item descriptor areas
* 17.2 <allocate descriptor statement>
* 17.3 <deallocate descriptor statement>
* 17.4 <get descriptor statement>
* 17.6 <prepare statement>
* 17.7 <deallocate prepared statement>
* 17.8 <describe statement>
* 17.9 <using clause>
* 17.12 <dynamic declare cursor>
* 17.14 <dynamic open statement>
* 17.15 <dynamic fetch statement>
* 17.16 <dynamic close statement>
* F#4 Joined table
* F#40 Full outer join
* F#1 Dynamic SQL
*
* DATE LAST ALTERED 02.01.96 CTS5 Hand-over Test
*
* QA Status: Full FC
*
* Revised by DWF 1996-03-27
* Added rollback after authid
* Removed EXEC SQL from printf
* Renamed variables
* Fixed coding rule violations
* Fixed syntax errors
* Fixed descriptor usage
* Fixed string lengths
* Fixed printout
* Fixed expected results
****************************************************************
* EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 SQLCODE PIC S9(9) COMP.
01 SQLSTATE PIC X(5).
01 colnam PIC X(20).
01 coltyp PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 eno PIC X(3).
01 enaam PIC X(20).
01 grd PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 cit PIC X(15).
01 hrs PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 sal PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 pno PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic2 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic3 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 uid PIC X(18).
01 uidx PIC X(18).
01 longst PIC X(240).
* EXEC SQL END DECLARE SECTION END-EXEC
01 norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 ALPNUM-TABLE VALUE IS
"01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ".
05 ALPNUM PIC X OCCURS 36 TIMES.
01 NORMSQ.
05 NORMSQX PIC X OCCURS 5 TIMES.
01 errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
*date_time declaration
01 TO-DAY PIC 9(6).
01 THE-TIME PIC 9(8).
01 flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
PROCEDURE DIVISION.
P0.
MOVE "CTS1 " TO uid
CALL "AUTHID" USING uid
MOVE "not logged in, not" TO uidx
* EXEC SQL SELECT USER INTO :uidx FROM CTS1.ECCO;
CALL "SUB1" USING SQLCODE SQLSTATE uidx
MOVE SQLCODE TO SQL-COD
* EXEC SQL ROLLBACK WORK;
CALL "SUB2" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if (uid NOT = uidx) then
DISPLAY "ERROR: User ", uid, " expected. User ", uidx, "
- " connected"
STOP RUN
END-IF
MOVE 0 TO errcnt
DISPLAY "SQL Test Suite, V6.0, Module COBOL, yts806.sco"
DISPLAY
"59-byte ID"
DISPLAY "TEd Version #"
*date_time print
ACCEPT TO-DAY FROM DATE
ACCEPT THE-TIME FROM TIME
DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
******************** BEGIN TEST7563 *******************
MOVE 1 TO flag
DISPLAY " TEST7563 "
DISPLAY " NATURAL FULL OUTER JOIN - dynamic"
DISPLAY "References:"
DISPLAY " 7.5 "
DISPLAY " 7.5 SR.6"
DISPLAY " 7.5 GR.1d"
DISPLAY " 7.5 GR.5d"
DISPLAY " 7.5 GR.6a"
DISPLAY " 17.1 Description of SQL item descriptor
- " areas"
DISPLAY " 17.2 "
DISPLAY " 17.3 "
DISPLAY " 17.4 "
DISPLAY " 17.6 "
DISPLAY " 17.7 "
DISPLAY " 17.8 "
DISPLAY " 17.9 "
DISPLAY " 17.12 "
DISPLAY " 17.14 "
DISPLAY " 17.15 "
DISPLAY " 17.16 "
DISPLAY " F#4 Joined table."
DISPLAY " F#40 Full outer join."
DISPLAY " F#1 Dynamic SQL."
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*prepare database
DISPLAY "DELETE FROM CTS1.STAFF1;"
* EXEC SQL DELETE FROM CTS1.STAFF1;
CALL "SUB3" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "DELETE FROM CTS1.STAFFa;"
* EXEC SQL DELETE FROM CTS1.STAFFa;
CALL "SUB4" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E1','Alice',4,'Lyon');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E1','Alice',4,'Lyon');
CALL "SUB5" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E1','Alice',8,'Lyon');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E1','Alice',8,'Lyon');
CALL "SUB6" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E1','Alice',12,'Geneva');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E1','Alice',12,'Geneva');
CALL "SUB7" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E2','Betty',16,'Strasbourg');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E2','Betty',16,'Strasbourg');
CALL "SUB8" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E2','Betty',20,'Munich');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E2','Betty',20,'Munich');
CALL "SUB9" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E3','Colin',24,'Leuven');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E3','Colin',24,'Leuven');
CALL "SUB10" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFF1 VALUES"
DISPLAY "('E4','Daniel',28,'Cologne');"
* EXEC SQL INSERT INTO CTS1.STAFF1 VALUES
* ('E4','Daniel',28,'Cologne');
CALL "SUB11" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(20,40000,'E1',11,'Alice');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (20,40000,'E1',11,'Alice');
CALL "SUB12" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(15,20000,'E2',12,'Betty');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (15,20000,'E2',12,'Betty');
CALL "SUB13" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(15,20000,'E2',13,'Betty');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (15,20000,'E2',13,'Betty');
CALL "SUB14" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(10,15000,'E3',14,'Colin');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (10,15000,'E3',14,'Colin');
CALL "SUB15" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(10,8000,'E3',15,'Colin');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (10,8000,'E3',15,'Colin');
CALL "SUB16" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(10,8000,'E3',16,'Colin');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (10,8000,'E3',16,'Colin');
CALL "SUB17" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO CTS1.STAFFa VALUES"
DISPLAY "(30,50000,'E5',17,'Edward');"
* EXEC SQL INSERT INTO CTS1.STAFFa VALUES
* (30,50000,'E5',17,'Edward');
CALL "SUB18" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CTS1.CONCATBUF;
CALL "SUB19" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CTS1.CONCATBUF VALUES (
* 'SELECT * FROM STAFF1 NATURAL FULL OUTER JOIN' ||
* ' STAFFA ORDER BY EMPNUM, EMPNAME, GRADE, PNUM'
* );
CALL "SUB20" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CTS1.CONCATBUF
* ;
CALL "SUB21" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=""", longst, """"
DISPLAY "PREPARE sn FROM :longst;"
* EXEC SQL PREPARE sn FROM :longst;
CALL "SUB22" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Demand that they be able to allocate at least 7. This is an
*Intermediate test, so their descriptors have no excuse to be
*wimpy.
DISPLAY "ALLOCATE DESCRIPTOR 'dn' WITH MAX 7;"
* EXEC SQL ALLOCATE DESCRIPTOR 'dn' WITH MAX 7;
CALL "SUB23" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DESCRIBE sn USING SQL DESCRIPTOR 'dn';"
* EXEC SQL DESCRIBE sn USING SQL DESCRIPTOR 'dn';
CALL "SUB24" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 1 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 1 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB25" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be EMPNUM; its value is ", colnam
DISPLAY "coltyp should be 1 (CHAR); its value is ", coltyp
if (colnam NOT = "EMPNUM" OR coltyp NOT = 1) then
MOVE 0 TO flag
END-IF
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 2 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 2 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB26" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be EMPNAME; its value is ", colnam
DISPLAY "coltyp should be 1 (CHAR); its value is ", coltyp
if (colnam NOT = "EMPNAME" OR coltyp NOT = 1) then
MOVE 0 TO flag
END-IF
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 3 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 3 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB27" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be GRADE; its value is ", colnam
DISPLAY "coltyp should be 3 (DECIMAL); its value is ",
coltyp
if (colnam NOT = "GRADE" OR coltyp NOT = 3) then
MOVE 0 TO flag
END-IF
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 4 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 4 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB28" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be CITY; its value is ", colnam
DISPLAY "coltyp should be 1 (CHAR); its value is ", coltyp
if (colnam NOT = "CITY" OR coltyp NOT = 1) then
MOVE 0 TO flag
END-IF
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 5 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 5 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB29" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be HOURS; its value is ", colnam
DISPLAY "coltyp should be 4 (INT); its value is ", coltyp
if (colnam NOT = "HOURS" OR coltyp NOT = 4) then
MOVE 0 TO flag
END-IF
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 6 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 6 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB30" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be SALARY; its value is ", colnam
DISPLAY "coltyp should be 3 (DECIMAL); its value is ",
coltyp
if (colnam NOT = "SALARY" OR coltyp NOT = 3) then
MOVE 0 TO flag
END-IF
MOVE "xxxxxxxxxxxxxxxxxxxx" TO colnam
MOVE 0 TO coltyp
DISPLAY "GET DESCRIPTOR 'dn' VALUE 7 :colnam = NAME,
- " :coltyp = TYPE;"
* EXEC SQL GET DESCRIPTOR 'dn' VALUE 7 :colnam = NAME,
* :coltyp = TYPE;
CALL "SUB31" USING SQLCODE SQLSTATE colnam coltyp
MOVE SQLCODE TO SQL-COD
DISPLAY "colnam should be PNUM; its value is ", colnam
DISPLAY "coltyp should be 3 (DECIMAL); its value is ",
coltyp
if (colnam NOT = "PNUM" OR coltyp NOT = 3) then
MOVE 0 TO flag
END-IF
*execute a <dynamic declare cursor> for statement sn
DISPLAY "DECLARE cn CURSOR for sn;"
* EXEC SQL DECLARE cn CURSOR FOR sn END-EXEC
DISPLAY "OPEN cn;"
* EXEC SQL OPEN cn;
CALL "SUB32" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Return each row defined by the cursor
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB33" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E1; its value is ", eno
DISPLAY "enaam should be Alice; its value is ", enaam
DISPLAY "grd should be 4; its value is ", grd
DISPLAY "cit should be Lyon; its value is ", cit
DISPLAY "hrs should be 20; its value is ", hrs
DISPLAY "sal should be 40000; its value is ", sal
DISPLAY "pno should be 11; its value is ", pno
if (eno NOT = "E1" OR enaam NOT = "Alice" OR
grd NOT = 4) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Lyon" OR hrs NOT = 20 OR sal NOT
= 40000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 11) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB34" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E1; its value is ", eno
DISPLAY "enaam should be Alice; its value is ", enaam
DISPLAY "grd should be 8; its value is ", grd
DISPLAY "cit should be Lyon; its value is ", cit
DISPLAY "hrs should be 20; its value is ", hrs
DISPLAY "sal should be 40000; its value is ", sal
DISPLAY "pno should be 11; its value is ", pno
if (eno NOT = "E1" OR enaam NOT = "Alice" OR
grd NOT = 8) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Lyon" OR hrs NOT = 20 OR sal NOT
= 40000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 11) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB35" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E1; its value is ", eno
DISPLAY "enaam should be Alice; its value is ", enaam
DISPLAY "grd should be 12; its value is ", grd
DISPLAY "cit should be Geneva; its value is ", cit
DISPLAY "hrs should be 20; its value is ", hrs
DISPLAY "sal should be 40000; its value is ", sal
DISPLAY "pno should be 11; its value is ", pno
if (eno NOT = "E1" OR enaam NOT = "Alice" OR
grd NOT = 12) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Geneva" OR hrs NOT = 20 OR sal
NOT = 40000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 11) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB36" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E2; its value is ", eno
DISPLAY "enaam should be Betty; its value is ", enaam
DISPLAY "grd should be 16; its value is ", grd
DISPLAY "cit should be Strasbourg; its value is ", cit
DISPLAY "hrs should be 15; its value is ", hrs
DISPLAY "sal should be 20000; its value is ", sal
DISPLAY "pno should be 12; its value is ", pno
if (eno NOT = "E2" OR enaam NOT = "Betty" OR
grd NOT = 16) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Strasbourg" OR hrs NOT = 15 OR sal
NOT = 20000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 12) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB37" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E2; its value is ", eno
DISPLAY "enaam should be Betty; its value is ", enaam
DISPLAY "grd should be 16; its value is ", grd
DISPLAY "cit should be Strasbourg; its value is ", cit
DISPLAY "hrs should be 15; its value is ", hrs
DISPLAY "sal should be 20000; its value is ", sal
DISPLAY "pno should be 13; its value is ", pno
if (eno NOT = "E2" OR enaam NOT = "Betty" OR
grd NOT = 16) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Strasbourg" OR hrs NOT = 15 OR sal
NOT = 20000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 13) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB38" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E2; its value is ", eno
DISPLAY "enaam should be Betty; its value is ", enaam
DISPLAY "grd should be 20; its value is ", grd
DISPLAY "cit should be Munich; its value is ", cit
DISPLAY "hrs should be 15; its value is ", hrs
DISPLAY "sal should be 20000; its value is ", sal
DISPLAY "pno should be 12; its value is ", pno
if (eno NOT = "E2" OR enaam NOT = "Betty" OR
grd NOT = 20) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Munich" OR hrs NOT = 15 OR sal
NOT = 20000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 12) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB39" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E2; its value is ", eno
DISPLAY "enaam should be Betty; its value is ", enaam
DISPLAY "grd should be 20; its value is ", grd
DISPLAY "cit should be Munich; its value is ", cit
DISPLAY "hrs should be 15; its value is ", hrs
DISPLAY "sal should be 20000; its value is ", sal
DISPLAY "pno should be 13; its value is ", pno
if (eno NOT = "E2" OR enaam NOT = "Betty" OR
grd NOT = 20) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Munich" OR hrs NOT = 15 OR sal
NOT = 20000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 13) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB40" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E3; its value is ", eno
DISPLAY "enaam should be Colin; its value is ", enaam
DISPLAY "grd should be 24; its value is ", grd
DISPLAY "cit should be Leuven; its value is ", cit
DISPLAY "hrs should be 10; its value is ", hrs
DISPLAY "sal should be 15000; its value is ", sal
DISPLAY "pno should be 14; its value is ", pno
if (eno NOT = "E3" OR enaam NOT = "Colin" OR
grd NOT = 24) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Leuven" OR hrs NOT = 10 OR sal
NOT = 15000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 14) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB41" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E3; its value is ", eno
DISPLAY "enaam should be Colin; its value is ", enaam
DISPLAY "grd should be 24; its value is ", grd
DISPLAY "cit should be Leuven; its value is ", cit
DISPLAY "hrs should be 10; its value is ", hrs
DISPLAY "sal should be 8000; its value is ", sal
DISPLAY "pno should be 15; its value is ", pno
if (eno NOT = "E3" OR enaam NOT = "Colin" OR
grd NOT = 24) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Leuven" OR hrs NOT = 10 OR sal
NOT = 8000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 15) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB42" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "eno should be E3; its value is ", eno
DISPLAY "enaam should be Colin; its value is ", enaam
DISPLAY "grd should be 24; its value is ", grd
DISPLAY "cit should be Leuven; its value is ", cit
DISPLAY "hrs should be 10; its value is ", hrs
DISPLAY "sal should be 8000; its value is ", sal
DISPLAY "pno should be 16; its value is ", pno
if (eno NOT = "E3" OR enaam NOT = "Colin" OR
grd NOT = 24) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Leuven" OR hrs NOT = 10 OR sal
NOT = 8000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 16) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
COMPUTE grd = -1
MOVE "xxxxxxxxxxxxxxx" TO cit
MOVE 99 TO indic1
MOVE 99 TO indic2
MOVE 99 TO indic3
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit,
- " :hrs:indic1,"
DISPLAY ":sal:indic2, :pno:indic3;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs:indic1, :sal:indic2,
* :pno:indic3;
CALL "SUB43" USING SQLCODE SQLSTATE eno enaam grd cit hrs
indic1 sal indic2 pno indic3
MOVE SQLCODE TO SQL-COD
DISPLAY "eno should be E4; its value is ", eno
DISPLAY "enaam should be Daniel; its value is ", enaam
DISPLAY "grd should be 28; its value is ", grd
DISPLAY "cit should be Cologne; its value is ", cit
DISPLAY "indic1 should be -1; its value is ", indic1
DISPLAY "indic2 should be -1; its value is ", indic2
DISPLAY "indic3 should be -1; its value is ", indic3
if (eno NOT = "E4" OR enaam NOT = "Daniel" OR
grd NOT = 28) then
MOVE 0 TO flag
END-IF
if (cit NOT = "Cologne" OR indic1 NOT = -1 OR
indic2 NOT = -1) then
MOVE 0 TO flag
END-IF
if (indic3 NOT = -1) then
MOVE 0 TO flag
END-IF
MOVE "xxx" TO eno
MOVE "xxxxxxxxxxxxxxxxxxxx" TO enaam
MOVE 99 TO indic1
MOVE 99 TO indic2
COMPUTE hrs = -1
COMPUTE sal = -1
COMPUTE pno = -1
DISPLAY "FETCH cn INTO "
DISPLAY ":eno, :enaam, :grd:indic1, :cit:indic2, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd:indic1, :cit:indic2, :hrs, :sal, :pno
* ;
CALL "SUB44" USING SQLCODE SQLSTATE eno enaam grd indic1
cit indic2 hrs sal pno
MOVE SQLCODE TO SQL-COD
DISPLAY "eno should be E5; its value is ", eno
DISPLAY "enaam should be Edward; its value is ", enaam
DISPLAY "hrs should be 30; its value is ", hrs
DISPLAY "sal should be 50000; its value is ", sal
DISPLAY "pno should be 17; its value is ", pno
DISPLAY "indic1 should be -1; its value is ", indic1
DISPLAY "indic2 should be -1; its value is ", indic2
if (eno NOT = "E5" OR enaam NOT = "Edward") then
MOVE 0 TO flag
END-IF
if (indic1 NOT = -1 OR indic2 NOT = -1) then
MOVE 0 TO flag
END-IF
if (hrs NOT = 30 OR sal NOT = 50000) then
MOVE 0 TO flag
END-IF
if (pno NOT = 17) then
MOVE 0 TO flag
END-IF
DISPLAY "FETCH cn INTO :eno, :enaam, :grd, :cit, :hrs,
- " :sal, :pno;"
* EXEC SQL FETCH cn INTO
* :eno, :enaam, :grd, :cit, :hrs, :sal, :pno;
CALL "SUB45" USING SQLCODE SQLSTATE eno enaam grd cit hrs
sal pno
MOVE SQLCODE TO SQL-COD
*That should generate a no data exception
*which is SQLSTATE 02000
DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
if (SQLCODE NOT = 100) then
MOVE 0 TO flag
END-IF
DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NORMSQ NOT = "02000") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "02000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY " "
DISPLAY "CLOSE cn;"
* EXEC SQL CLOSE cn;
CALL "SUB46" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB47" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " yts806.mco *** pass *** "
* EXEC SQL INSERT INTO CTS1.TESTREPORT
* VALUES('7563','pass','MCO');
CALL "SUB48" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " yts806.mco *** fail *** "
* EXEC SQL INSERT INTO CTS1.TESTREPORT
* VALUES('7563','fail','MCO');
CALL "SUB49" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB50" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST7563 ********************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
*Test SQLCODE and SQLSTATE for normal completion.
CHCKOK.
DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT = 0 OR NORMSQ NOT = "00000") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "00000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
.
NOSUBCLASS.
*This routine replaces valid implementation-defined
*subclasses with 000. This replacement equates valid
*implementation-defined subclasses with the 000 value
*expected by the test case; otherwise the test will fail.
*After calling NOSUBCLASS, NORMSQ will be tested
* SQLSTATE will be printed.
MOVE SQLSTATE TO NORMSQ
MOVE 3 TO norm1
*subclass begins in position 3 of char array NORMSQ
*valid subclass begins with 5-9, I-Z, end of ALPNUM table
PERFORM VARYING norm2 FROM 14 BY 1 UNTIL norm2 > 36
if (NORMSQX(norm1) = ALPNUM(norm2)) then
MOVE "0" TO NORMSQX(norm1)
END-IF
END-PERFORM
*Quit if NORMSQ is unchanged. Subclass is not impl.-def.
*Changed NORMSQ means implementation-defined subclass,
*so proceed to zero it out, if valid (0-9,A-Z)
if (NORMSQ = SQLSTATE) then
GO TO EXIT-NOSUBCLASS
END-IF
MOVE 4 TO norm1
*examining position 4 of char array NORMSQ
*valid characters are 0-9, A-Z
PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
if (NORMSQX(norm1) = ALPNUM(norm2)) then
MOVE "0" TO NORMSQX(norm1)
END-IF
END-PERFORM
MOVE 5 TO norm1
*valid characters are 0-9, A-Z
*examining position 5 of char array NORMSQ
PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
if (NORMSQX(norm1) = ALPNUM(norm2)) then
MOVE "0" TO NORMSQX(norm1)
END-IF
END-PERFORM
*implementation-defined subclasses are allowed for warnings
*(class = 01). These equate to successful completion
*SQLSTATE values of 00000.
*Reference SQL-92 4.28 SQL-transactions, paragraph 2
if (NORMSQX(1) = "0" AND NORMSQX(2) = "1") then
MOVE "0" TO NORMSQX(2)
END-IF
.
EXIT-NOSUBCLASS.
EXIT.
¤ Dauer der Verarbeitung: 0.72 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.
|
|
|
