| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ Datei vom 4.1.2008 mit Größe 5 kB |
|
Quelle dml042.cob Sprache: Cobol |
|||||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML042. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "DML042.SCO") calling SQL * procedures in file "DML042.MCO" **************************************************************** * * COMMENT SECTION * * DATE 1988/11/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. * * DML042.SCO * WRITTEN BY: HU YANPING * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * THIS ROUTINE TESTS THE LIMIT ON THE NUMBER OF COLUMNS IN A * TABLE. THIS LIMIT IS NOT LESS THAN ONE HUNDRED (100). * * REFERENCES * AMERICAN NATIONAL STANDARD database language - SQL * X3.135-1989 * * FIPS PUB 127-1, Section 13.5 * Sizing for database constructs * **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 vc1 PIC X(2). 01 vc21 PIC X(2). 01 vc41 PIC X(2). 01 vc61 PIC X(2). 01 vc81 PIC X(2). 01 vc100 PIC X(2). * EXEC SQL END DECLARE SECTION END-EXEC 01 i PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 uid PIC X(18). 01 uidx PIC X(18). 01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQLCODE PIC S9(9) COMP. 01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE. * date_time declaration * 01 TO-DAY PIC 9(6). 01 THE-TIME PIC 9(8). PROCEDURE DIVISION. P0. MOVE "HU" TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx CALL "AUTHCK" USING SQLCODE uidx MOVE SQLCODE TO SQL-COD if (uid NOT = uidx) then DISPLAY "ERROR: User " uid " expected." DISPLAY "User " uidx " connected." DISPLAY " " STOP RUN END-IF MOVE 0 TO errcnt DISPLAY "SQL Test Suite, V6.0, Module COBOL, dml042.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 TEST0213 ******************* DISPLAY " FIPS sizing TEST0213 " DISPLAY " This routine tests the number of columns (100) in - " a row" DISPLAY " - - - - - - - - - - - - - - - - - - -" * EXEC SQL INSERT INTO T100(C1,C21,C41,C61,C81,C100) * VALUES(' 1','21','41','61','81','00') END-EXEC CALL "SUB1" USING SQLCODE MOVE SQLCODE TO SQL-COD MOVE SQLCODE TO i * EXEC SQL SELECT C1,C21,C41,C61,C81,C100 * INTO :vc1,:vc21,:vc41,:vc61,:vc81,:vc100 * FROM T100 END-EXEC CALL "SUB2" USING SQLCODE vc1 vc21 vc41 vc61 vc81 vc100 MOVE SQLCODE TO SQL-COD MOVE SQLCODE TO ii DISPLAY "i = ", i ", ii = ", ii " " DISPLAY "vc1 = ", vc1 ",vc21 = ", vc21 ",vc41 = ", vc41 DISPLAY "vc61 = ", vc61 ",vc81 = ", vc81 ",vc100 = ", vc100 " - " " * EXEC SQL ROLLBACK WORK; CALL "SUB3" USING SQLCODE MOVE SQLCODE TO SQL-COD if (i = 0 AND ii = 0 AND vc1 = " 1" AND vc100 = "00") then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0213','pass','MCO') END-EXEC CALL "SUB4" USING SQLCODE MOVE SQLCODE TO SQL-COD else DISPLAY "dml042.sco *** fail *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0213','fail','MCO') END-EXEC ADD 1 TO errcnt CALL "SUB5" USING SQLCODE MOVE SQLCODE TO SQL-COD END-IF DISPLAY "===================================================" DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB6" USING SQLCODE MOVE SQLCODE TO SQL-COD ******************** END TEST0213 ******************* **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements ¤ Dauer der Verarbeitung: 0.10 Sekunden (vorverarbeitet) ¤*© Formatika GbR, Deutschland |
|
2026-03-28