Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: yts764.cob   Sprache: Unknown

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


      * Standard COBOL (file "YTS764.SCO") calling SQL
      * procedures in file "YTS764.MCO".


      *Copyright 1996 National Computing Centre Limited, 
      *and Computer Logic R&D S.A 
      *on behalf of the 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                               
      *                                                              
      * YTS764.SCO                                                   
      * WRITTEN BY:  Susan Watters                                   
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
      *                                                              
      * <query expression> with UNION ALL CORRESPONDING BY           
      *                                                              
      *                                                              
      * REFERENCES                                                   
      *   7.10   <query expression>                                  
      *   7.10   SR.9a                                               
      *   7.10   SR.10a                                              
      *   7.10   GR1.b                                               
      *   7.3    <table expression>                                  
      *   13.1   <declare cursor >                                   
      *   F#30   Table operations                                    
      *                                                              
      * DATE LAST ALTERED 02.01.96 CTS5 Hand-over Test               
      * Program updated to replace derived table - 8th December 1995 
      *                                                              
      * QA Status: Full FC                                           
      *                                                              
      * Revised by DWF 1996-03-08                                    
      *   Added rollback after authid                                
      *   Made # columns match # values inserted                     
      *   Fixed expected results                                     
      ****************************************************************



      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
       01  i PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  h PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  s PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
      *  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, yts764.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 TEST7519 *******************
      *initialise all variables 
             MOVE 1 TO flag

             DISPLAY " TEST7519 "
             DISPLAY " with UNION ALL CORRESPONDING
      -    " BY"
             DISPLAY "References:"
             DISPLAY " 7.10 "
             DISPLAY " 7.10 SR.9a"
             DISPLAY " 7.10 SR.10a"
             DISPLAY " 7.10 GR.1b"
             DISPLAY " 7.3 "
             DISPLAY " 13.1 "
             DISPLAY " F#30 Table operations"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY "DELETE FROM CTS1.ET;"
      *  EXEC SQL DELETE FROM CTS1.ET;
             CALL "SUB3" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY  " "

      *inserted into CTS1.STAFFb : 
      *are three or more copies of some rows, 
      *two copies of other rows and some rows that are not duplicated 
      *For rows that are not duplicated some rows are included which 
      *would be duplicates if only the corresponding rows were conside

      *Inserted into CTS1.STAFFa are : 
      *some rows which are duplicates of rows in CTS1.STAFFb 
      *considering only corresponding rows 
      *Some cases are included where the multiplicity of rows is more 
      *equal to and less than the multiplicity of that row in 
      *CTS1.STAFFb 

      *return no of rows in tables 
             MOVE 0 TO i
             DISPLAY "Check the correct number of rows have been
      -    " inserted"
             DISPLAY "SELECT COUNT (*) INTO :i FROM CTS1.STAFFb;"
      *  EXEC SQL SELECT COUNT (*) INTO :i FROM CTS1.STAFFb;
             CALL "SUB4" USING SQLCODE SQLSTATE i
             MOVE SQLCODE TO SQL-COD
             DISPLAY "i should be 12; its value is ", i
             if (i  NOT =  12) then
               MOVE 0 TO flag
             END-IF

      *reinitialise host variable 

             MOVE 0 TO i
             DISPLAY "SELECT COUNT (*) INTO :i FROM CTS1.STAFFa;"
      *  EXEC SQL SELECT COUNT (*) INTO :i FROM CTS1.STAFFa;
             CALL "SUB5" USING SQLCODE SQLSTATE i
             MOVE SQLCODE TO SQL-COD
             DISPLAY "i should be 12; its value is ", i
             if (i  NOT =  12) then
               MOVE 0 TO flag
             END-IF

      *define cursor 

             DISPLAY "INSERT INTO CTS1.ET (col5, col6)"
             DISPLAY "SELECT * FROM CTS1.STAFFB"
             DISPLAY "UNION ALL CORRESPONDING BY (hours, salary)"
             DISPLAY "SELECT * FROM CTS1.STAFFA;"
      *  EXEC SQL INSERT INTO CTS1.ET (col5, col6)
      *    SELECT * FROM CTS1.STAFFB
      *    UNION ALL CORRESPONDING BY (hours, salary)
      *    SELECT * FROM CTS1.STAFFA;
             CALL "SUB6" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Hours Salary 
      *24 rows 

             DISPLAY "DECLARE data64 CURSOR FOR"
             DISPLAY "SELECT COUNT (*), col5, col6"
             DISPLAY "FROM CTS1.ET"
             DISPLAY "GROUP BY col6, col5"
             DISPLAY "ORDER BY 2,3;"
      *  EXEC SQL DECLARE data64 CURSOR FOR
      *    SELECT COUNT (*), col5, col6
      *    FROM CTS1.ET
      *    GROUP BY col6, col5
      *    ORDER BY 2,3 END-EXEC

      *open cursor 
             DISPLAY "OPEN data64;"
      *  EXEC SQL OPEN data64;
             CALL "SUB7" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB8" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 1; its value is ", i
             DISPLAY "h should be 15; its value is ", h
             DISPLAY "s should be 7000; its value is ", s
             if (i  NOT =  1  OR  h  NOT =  15  OR  s  NOT =  7000) then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB9" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 1; its value is ", i
             DISPLAY "h should be 30; its value is ", h
             DISPLAY "s should be 8000; its value is ", s
             if (i  NOT =  1  OR  h  NOT =  30  OR  s  NOT =  8000) then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB10" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 3; its value is ", i
             DISPLAY "h should be 30; its value is ", h
             DISPLAY "s should be 20000; its value is ", s
             if (i  NOT =  3  OR  h  NOT =  30  OR  s  NOT =  20000)
             then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB11" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 2; its value is ", i
             DISPLAY "h should be 35; its value is ", h
             DISPLAY "s should be 15000; its value is ", s
             if (i  NOT =  2  OR  h  NOT =  35  OR  s  NOT =  15000)
             then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB12" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 9; its value is ", i
             DISPLAY "h should be 40; its value is ", h
             DISPLAY "s should be 10000; its value is ", s
             if (i  NOT =  9  OR  h  NOT =  40  OR  s  NOT =  10000)
             then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB13" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 2; its value is ", i
             DISPLAY "h should be 60; its value is ", h
             DISPLAY "s should be 45000; its value is ", s
             if (i  NOT =  2  OR  h  NOT =  60  OR  s  NOT =  45000)
             then
               MOVE 0 TO flag
             END-IF

             MOVE 0 TO i
             MOVE 0 TO h
             MOVE 0 TO s
             DISPLAY "FETCH data64 INTO :i, :h, :s"
      *  EXEC SQL FETCH data64 INTO :i, :h, :s;
             CALL "SUB14" USING SQLCODE SQLSTATE i h s
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "i should be 6; its value is ", i
             DISPLAY "h should be 70; its value is ", h
             DISPLAY "s should be 40000; its value is ", s
             if (i  NOT =  6  OR  h  NOT =  70  OR  s  NOT =  40000)
             then
               MOVE 0 TO flag
             END-IF

             DISPLAY "CLOSE data64"
      *  EXEC SQL CLOSE data64;
             CALL "SUB15" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB16" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " yts764.mco *** pass *** "
      *    EXEC SQL INSERT INTO CTS1.TESTREPORT
      *      VALUES('7519','pass','MCO');
               CALL "SUB17" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " yts764.mco *** fail *** "
      *    EXEC SQL INSERT INTO CTS1.TESTREPORT
      *      VALUES('7519','fail','MCO');
               CALL "SUB18" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB19" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST7519 ********************


      **** 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.7 Sekunden  (vorverarbeitet)  ]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....
    

Besucherstatistik

Besucherstatistik