IDENTIFICATION DIVISION .PROGRAM-ID . DML010.ENVIRONMENT DIVISION .CONFIGURATION SECTION .SOURCE-COMPUTER . xyz.OBJECT-COMPUTER . xyz.DATA DIVISION .WORKING-STORAGE SECTION . * Standard COBOL (file "DML010.SCO") calling SQL * procedures in file "DML010.MCO" **************************************************************** * * COMMENT SECTION * * DATE 1987/08/21 STANDARD COBOL LANGUAGE * 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. * * DML010.SCO * WRITTEN BY: HU YANPING * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * THIS PROGRAM TESTS THE HANDLING OF CHARACTER STRING (SPACE * FILLING, TRUNCATING ETC.) INTO TEST COLUMNS. IT ALSO TESTS * THE USE OF NUMERIC DATATYPES IN INSERT STATEMENTS. * * REFERENCES * AMERICAN NATIONAL STANDARD database language - SQL * X3.135-1989 * * SECTION 8.3 <declare cursor> * SECTION 8.6 <fetch statement> * SECTION 8.7 <insert statement> * SECTION 8.8 <open statement> * **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC PIC S9(4) DISPLAY SIGN LEADING SEPARATE .PIC S9(4) DISPLAY SIGN LEADING SEPARATE .PIC X(10).PIC X(10).PIC X(10).PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC X(10). * EXEC SQL END DECLARE SECTION END-EXEC PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC X(18).PIC X(18).PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC S9(9) COMP .PIC S9(4) DISPLAY SIGN LEADING SEPARATE .PIC S9(4) DISPLAY SIGN LEADING SEPARATE . * date_time declaration * PIC 9(6).PIC 9(8).PROCEDURE DIVISION .MOVE "HU" TO uidCALL "AUTHID" USING uidMOVE "not logged in, not" TO uidxCALL "AUTHCK" USING SQLCODE uidxMOVE SQLCODE TO SQL-CODif (uid NOT = uidx) then DISPLAY "ERROR: User " uid " expected." DISPLAY "User " uidx " connected." DISPLAY " " STOP RUN END-IF MOVE 0 TO errcntDISPLAY "SQL Test Suite, V6.0, Module COBOL, dml010.sco" DISPLAY " " DISPLAY "59-byte ID" DISPLAY "TEd Version #" DISPLAY " " * date_time print * ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME ******************** BEGIN TEST0027 ******************* * CREATE TABLE TMP (T1 CHAR(10),T2 DECIMAL(2), T3 CHAR(10)) DISPLAY " TEST0027 " DISPLAY "Insert short string into long column with space " filling" DISPLAY " - - - - - - - - - - - - - - - - - - - - - -" MOVE "xxxx" TO t10MOVE "xxxx" TO t30MOVE 23 TO t21 * EXEC SQL INSERT INTO TMP (T1, T2, T3) * VALUES (:t10, :t21, :t30) END-EXEC CALL "SUB1" USING SQLCODE t10 t21 t30MOVE SQLCODE TO SQL-CODDISPLAY " SQLCODE = " , SQL-COD " " " " MOVE " " TO t11MOVE 0 TO t21 * EXEC SQL SELECT * * INTO :t11, :t21, :t31 * FROM TMP * WHERE T2 = 23 END-EXEC CALL "SUB2" USING SQLCODE t11 t21 t31MOVE SQLCODE TO SQL-CODDISPLAY " t11=" , t11 ", t21=" , t21 ", t31=" , t31 " " * EXEC SQL ROLLBACK WORK; CALL "SUB3" USING SQLCODEMOVE SQLCODE TO SQL-CODif (t11 = "xxxx " ) then DISPLAY " *** pass ***" DISPLAY "==================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0027','pass','MCO') END-EXEC CALL "SUB4" USING SQLCODEMOVE SQLCODE TO SQL-CODelse DISPLAY " dml010.sco *** fail ***" DISPLAY "==================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0027','fail','MCO') END-EXEC ADD 1 TO errcntCALL "SUB5" USING SQLCODEMOVE SQLCODE TO SQL-CODEND-IF DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB6" USING SQLCODEMOVE SQLCODE TO SQL-COD ******************** END TEST0027 ******************* ******************** BEGIN TEST0028 ******************* DISPLAY " TEST0028 " DISPLAY "Insert character string that exactly fits in the " column" DISPLAY " - - - - - - - - - - - - - - - - - - - - - - -" MOVE "xxxxxxxxxx" TO t10MOVE "xxxxxxxxxx" TO t30MOVE 23 TO t21 * EXEC SQL INSERT INTO TMP (T1, T2, T3) VALUES (:t10, :t21, * :t30) END-EXEC CALL "SUB7" USING SQLCODE t10 t21 t30MOVE SQLCODE TO SQL-CODMOVE SQLCODE TO iiDISPLAY " ii = " , ii " " MOVE " " TO t11MOVE 0 TO t21 * EXEC SQL SELECT * * INTO :t11, :t21, :t31 * FROM TMP * WHERE T2 = 23 END-EXEC CALL "SUB8" USING SQLCODE t11 t21 t31MOVE SQLCODE TO SQL-CODDISPLAY " SQLCODE = " , SQL-COD " " DISPLAY " t11=" , t11 ", t21=" , t21 ", t31=" , t31 " " DISPLAY "The correct answer should be ii=0 & t11=xxxxxxxxxx " " * EXEC SQL ROLLBACK WORK; CALL "SUB9" USING SQLCODEMOVE SQLCODE TO SQL-CODif ( t11 = "xxxxxxxxxx" AND ii = 0) then DISPLAY " *** pass ***" DISPLAY "==================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0028','pass','MCO') END-EXEC CALL "SUB10" USING SQLCODEMOVE SQLCODE TO SQL-CODelse DISPLAY " dml010.sco *** fail ***" DISPLAY "==================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0028','fail','MCO') END-EXEC ADD 1 TO errcntCALL "SUB11" USING SQLCODEMOVE SQLCODE TO SQL-CODEND-IF DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB12" USING SQLCODEMOVE SQLCODE TO SQL-COD ******************** END TEST0028 ******************* ******************** BEGIN TEST0031 ******************* DISPLAY " TEST0031 " DISPLAY " the orders of insert columns differ from " definition" DISPLAY " - - - - - - - - - - - - - - - - - - - - - -" MOVE "z" TO t11MOVE "zz" TO t31 * EXEC SQL INSERT INTO TMP (T2, T3, T1) VALUES (NULL, :t31, * :t11) END-EXEC CALL "SUB13" USING SQLCODE t31 t11MOVE SQLCODE TO SQL-CODDISPLAY " After INSERT, SQLCODE = " , SQL-COD " " MOVE " " TO t11 * EXEC SQL SELECT * * INTO :t11, :t21:indic1, :t31 * FROM TMP * WHERE T2 IS NULL END-EXEC CALL "SUB14" USING SQLCODE t11 t21 indic1 t31MOVE SQLCODE TO SQL-CODMOVE indic1 TO DISP1DISPLAY " indic1 = " , DISP1 " " DISPLAY " SQLCODE = " , SQL-COD " " MOVE SQLCODE TO ii * EXEC SQL ROLLBACK WORK; CALL "SUB15" USING SQLCODEMOVE SQLCODE TO SQL-CODif (ii NOT < 0 AND t11 = "z" ) then DISPLAY " *** pass ***" DISPLAY "==================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0031','pass','MCO') END-EXEC CALL "SUB16" USING SQLCODEMOVE SQLCODE TO SQL-CODelse DISPLAY " dml010.sco *** fail ***" DISPLAY "==================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0031','fail','MCO') END-EXEC ADD 1 TO errcntCALL "SUB17" USING SQLCODEMOVE SQLCODE TO SQL-CODEND-IF DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB18" USING SQLCODEMOVE SQLCODE TO SQL-COD ******************** END TEST0031 ******************* **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN . * **** Procedures for PERFORM statements quality 100%
¤ Dauer der Verarbeitung: 0.2 Sekunden
(vorverarbeitet)
¤ *© Formatika GbR, Deutschland
