Quellcode-Bibliothek dml183.cob

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  DML183.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  xyz.
       OBJECT-COMPUTER.  xyz.
       DATA DIVISION.
       WORKING-STORAGE SECTION.


      * EMBEDDED COBOL (file "DML183.PCO")


      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1996-05-22 EMBEDDED COBOL LANGUAGE                          
      * 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.
      *                                                              
      * DML183.PCO                                                    
      * WRITTEN BY:  David Flater                                    
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      *                                                              
      * This routine tests Intermediate SQL.                         
      *                                                              
      * REFERENCES                                                   
      *   FIPS PUB 127-2 14.2 Intermediate SQL                       
      *   ANSI SQL-1992                                              
      *                                                              
      ****************************************************************




           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  enuum PIC  X(3).
       01  casgrd PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
             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 "FLATER            " 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
             EXEC SQL ROLLBACK WORK END-EXEC
             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, Embedded COBOL, dml183.pco"
             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 TEST0896 *******************
             MOVE 1 TO flag

             DISPLAY "              FIPS sizing TEST0896"
             DISPLAY "FIPS sizing, 50 WHEN clauses in a CASE expression"
             DISPLAY "References:"
             DISPLAY "FIPS 16.6 -- Sizing #38, WHEN clauses in a CASE
      -    " expression"
             DISPLAY "F#26 -- CASE expression"
             DISPLAY "6.9 -- <case expression>"
             DISPLAY "   - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             MOVE 0 TO casgrd
             MOVE "xxx" TO enuum
             DISPLAY "SELECT EMPNUM,"
             DISPLAY "  CASE GRADE"
             DISPLAY "    WHEN 0 THEN 1000"
             DISPLAY "    WHEN 1 THEN 997"
             DISPLAY "    WHEN 2 THEN 994"
             DISPLAY "    WHEN 3 THEN 991"
             DISPLAY "    WHEN 4 THEN 988"
             DISPLAY "    WHEN 5 THEN 985"
             DISPLAY "    WHEN 6 THEN 982"
             DISPLAY "    WHEN 7 THEN 979"
             DISPLAY "    WHEN 8 THEN 976"
             DISPLAY "    WHEN 9 THEN 973"
             DISPLAY "    WHEN 10 THEN 970"
             DISPLAY "    WHEN 11 THEN 967"
             DISPLAY "    WHEN 12 THEN 964"
             DISPLAY "    WHEN 13 THEN 961"
             DISPLAY "    WHEN 14 THEN 958"
             DISPLAY "    WHEN 15 THEN 955"
             DISPLAY "    WHEN 16 THEN 952"
             DISPLAY "    WHEN 17 THEN 949"
             DISPLAY "    WHEN 18 THEN 946"
             DISPLAY "    WHEN 19 THEN 943"
             DISPLAY "    WHEN 20 THEN 940"
             DISPLAY "    WHEN 21 THEN 937"
             DISPLAY "    WHEN 22 THEN 934"
             DISPLAY "    WHEN 23 THEN 931"
             DISPLAY "    WHEN 24 THEN 928"
             DISPLAY "    WHEN 25 THEN 925"
             DISPLAY "    WHEN 26 THEN 922"
             DISPLAY "    WHEN 27 THEN 919"
             DISPLAY "    WHEN 28 THEN 916"
             DISPLAY "    WHEN 29 THEN 913"
             DISPLAY "    WHEN 30 THEN 910"
             DISPLAY "    WHEN 31 THEN 907"
             DISPLAY "    WHEN 32 THEN 904"
             DISPLAY "    WHEN 33 THEN 901"
             DISPLAY "    WHEN 34 THEN 898"
             DISPLAY "    WHEN 35 THEN 895"
             DISPLAY "    WHEN 36 THEN 892"
             DISPLAY "    WHEN 37 THEN 889"
             DISPLAY "    WHEN 38 THEN 886"
             DISPLAY "    WHEN 39 THEN 883"
             DISPLAY "    WHEN 40 THEN 880"
             DISPLAY "    WHEN 41 THEN 877"
             DISPLAY "    WHEN 42 THEN 874"
             DISPLAY "    WHEN 43 THEN 871"
             DISPLAY "    WHEN 44 THEN 868"
             DISPLAY "    WHEN 45 THEN 865"
             DISPLAY "    WHEN 46 THEN 862"
             DISPLAY "    WHEN 47 THEN 859"
             DISPLAY "    WHEN 48 THEN 856"
             DISPLAY "    WHEN 49 THEN 853"
             DISPLAY "  END"
             DISPLAY "  INTO :enuum, :casgrd"
             DISPLAY "  FROM HU.STAFF"
             DISPLAY "  WHERE EMPNAME = 'Betty';"
             EXEC SQL SELECT EMPNUM,
               CASE GRADE
               WHEN 0 THEN 1000
               WHEN 1 THEN 997
               WHEN 2 THEN 994
               WHEN 3 THEN 991
               WHEN 4 THEN 988
               WHEN 5 THEN 985
               WHEN 6 THEN 982
               WHEN 7 THEN 979
               WHEN 8 THEN 976
               WHEN 9 THEN 973
               WHEN 10 THEN 970
               WHEN 11 THEN 967
               WHEN 12 THEN 964
               WHEN 13 THEN 961
               WHEN 14 THEN 958
               WHEN 15 THEN 955
               WHEN 16 THEN 952
               WHEN 17 THEN 949
               WHEN 18 THEN 946
               WHEN 19 THEN 943
               WHEN 20 THEN 940
               WHEN 21 THEN 937
               WHEN 22 THEN 934
               WHEN 23 THEN 931
               WHEN 24 THEN 928
               WHEN 25 THEN 925
               WHEN 26 THEN 922
               WHEN 27 THEN 919
               WHEN 28 THEN 916
               WHEN 29 THEN 913
               WHEN 30 THEN 910
               WHEN 31 THEN 907
               WHEN 32 THEN 904
               WHEN 33 THEN 901
               WHEN 34 THEN 898
               WHEN 35 THEN 895
               WHEN 36 THEN 892
               WHEN 37 THEN 889
               WHEN 38 THEN 886
               WHEN 39 THEN 883
               WHEN 40 THEN 880
               WHEN 41 THEN 877
               WHEN 42 THEN 874
               WHEN 43 THEN 871
               WHEN 44 THEN 868
               WHEN 45 THEN 865
               WHEN 46 THEN 862
               WHEN 47 THEN 859
               WHEN 48 THEN 856
               WHEN 49 THEN 853
               END
               INTO :enuum, :casgrd
               FROM HU.STAFF
               WHERE EMPNAME = 'Betty' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "enuum should be 'E2 '; its value is '", enuum, "'"
             if (enuum  NOT  =   "E2 ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "casgrd should be 970; its value is ", casgrd
             if (casgrd  NOT =  970) then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO casgrd
             MOVE "xxx" TO enuum
             DISPLAY "SELECT EMPNUM,"
             DISPLAY "  CASE"
             DISPLAY "    WHEN GRADE = 0 THEN 1000"
             DISPLAY "    WHEN GRADE = 1 THEN 997"
             DISPLAY "    WHEN GRADE = 2 THEN 994"
             DISPLAY "    WHEN GRADE = 3 THEN 991"
             DISPLAY "    WHEN GRADE = 4 THEN 988"
             DISPLAY "    WHEN GRADE = 5 THEN 985"
             DISPLAY "    WHEN GRADE = 6 THEN 982"
             DISPLAY "    WHEN GRADE = 7 THEN 979"
             DISPLAY "    WHEN GRADE = 8 THEN 976"
             DISPLAY "    WHEN GRADE = 9 THEN 973"
             DISPLAY "    WHEN GRADE = 11 THEN 967"
             DISPLAY "    WHEN GRADE = 12 THEN 964"
             DISPLAY "    WHEN GRADE = 13 THEN 961"
             DISPLAY "    WHEN GRADE = 14 THEN 958"
             DISPLAY "    WHEN GRADE = 15 THEN 955"
             DISPLAY "    WHEN GRADE = 16 THEN 952"
             DISPLAY "    WHEN GRADE = 17 THEN 949"
             DISPLAY "    WHEN GRADE = 18 THEN 946"
             DISPLAY "    WHEN GRADE = 19 THEN 943"
             DISPLAY "    WHEN GRADE = 20 THEN 940"
             DISPLAY "    WHEN GRADE = 21 THEN 937"
             DISPLAY "    WHEN GRADE = 22 THEN 934"
             DISPLAY "    WHEN GRADE = 23 THEN 931"
             DISPLAY "    WHEN GRADE = 24 THEN 928"
             DISPLAY "    WHEN GRADE = 25 THEN 925"
             DISPLAY "    WHEN GRADE = 26 THEN 922"
             DISPLAY "    WHEN GRADE = 27 THEN 919"
             DISPLAY "    WHEN GRADE = 28 THEN 916"
             DISPLAY "    WHEN GRADE = 29 THEN 913"
             DISPLAY "    WHEN GRADE = 30 THEN 910"
             DISPLAY "    WHEN GRADE = 31 THEN 907"
             DISPLAY "    WHEN GRADE = 32 THEN 904"
             DISPLAY "    WHEN GRADE = 33 THEN 901"
             DISPLAY "    WHEN GRADE = 34 THEN 898"
             DISPLAY "    WHEN GRADE = 35 THEN 895"
             DISPLAY "    WHEN GRADE = 36 THEN 892"
             DISPLAY "    WHEN GRADE = 37 THEN 889"
             DISPLAY "    WHEN GRADE = 38 THEN 886"
             DISPLAY "    WHEN GRADE = 39 THEN 883"
             DISPLAY "    WHEN GRADE = 40 THEN 880"
             DISPLAY "    WHEN GRADE = 41 THEN 877"
             DISPLAY "    WHEN GRADE = 42 THEN 874"
             DISPLAY "    WHEN GRADE = 43 THEN 871"
             DISPLAY "    WHEN GRADE = 44 THEN 868"
             DISPLAY "    WHEN GRADE = 45 THEN 865"
             DISPLAY "    WHEN GRADE = 46 THEN 862"
             DISPLAY "    WHEN GRADE = 47 THEN 859"
             DISPLAY "    WHEN GRADE = 48 THEN 856"
             DISPLAY "    WHEN GRADE = 49 THEN 853"
             DISPLAY "    WHEN GRADE = 10 THEN 970"
             DISPLAY "  END"
             DISPLAY "  INTO :enuum, :casgrd"
             DISPLAY "  FROM HU.STAFF"
             DISPLAY "  WHERE EMPNAME = 'Betty';"
             EXEC SQL SELECT EMPNUM,
               CASE
               WHEN GRADE = 0 THEN 1000
               WHEN GRADE = 1 THEN 997
               WHEN GRADE = 2 THEN 994
               WHEN GRADE = 3 THEN 991
               WHEN GRADE = 4 THEN 988
               WHEN GRADE = 5 THEN 985
               WHEN GRADE = 6 THEN 982
               WHEN GRADE = 7 THEN 979
               WHEN GRADE = 8 THEN 976
               WHEN GRADE = 9 THEN 973
               WHEN GRADE = 11 THEN 967
               WHEN GRADE = 12 THEN 964
               WHEN GRADE = 13 THEN 961
               WHEN GRADE = 14 THEN 958
               WHEN GRADE = 15 THEN 955
               WHEN GRADE = 16 THEN 952
               WHEN GRADE = 17 THEN 949
               WHEN GRADE = 18 THEN 946
               WHEN GRADE = 19 THEN 943
               WHEN GRADE = 20 THEN 940
               WHEN GRADE = 21 THEN 937
               WHEN GRADE = 22 THEN 934
               WHEN GRADE = 23 THEN 931
               WHEN GRADE = 24 THEN 928
               WHEN GRADE = 25 THEN 925
               WHEN GRADE = 26 THEN 922
               WHEN GRADE = 27 THEN 919
               WHEN GRADE = 28 THEN 916
               WHEN GRADE = 29 THEN 913
               WHEN GRADE = 30 THEN 910
               WHEN GRADE = 31 THEN 907
               WHEN GRADE = 32 THEN 904
               WHEN GRADE = 33 THEN 901
               WHEN GRADE = 34 THEN 898
               WHEN GRADE = 35 THEN 895
               WHEN GRADE = 36 THEN 892
               WHEN GRADE = 37 THEN 889
               WHEN GRADE = 38 THEN 886
               WHEN GRADE = 39 THEN 883
               WHEN GRADE = 40 THEN 880
               WHEN GRADE = 41 THEN 877
               WHEN GRADE = 42 THEN 874
               WHEN GRADE = 43 THEN 871
               WHEN GRADE = 44 THEN 868
               WHEN GRADE = 45 THEN 865
               WHEN GRADE = 46 THEN 862
               WHEN GRADE = 47 THEN 859
               WHEN GRADE = 48 THEN 856
               WHEN GRADE = 49 THEN 853
               WHEN GRADE = 10 THEN 970
               END
               INTO :enuum, :casgrd
               FROM HU.STAFF
               WHERE EMPNAME = 'Betty' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "enuum should be 'E2 '; its value is '", enuum, "'"
             if (enuum  NOT  =   "E2 ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "casgrd should be 970; its value is ", casgrd
             if (casgrd  NOT =  970) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY "                *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0896','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "       dml183.pco  *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0896','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

             DISPLAY "==============================================="

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0896 ********************
      **** 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.