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


Quelle  dml160.cob

  Sprache: Cobol
 

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


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


      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1995/12/11 Module 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.
      *                                                              
      * DML160.SCO                                                    
      * WRITTEN BY:  David Flater                                    
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
      *                                                              
      * This routine tests joined tables.                            
      *                                                              
      * 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  emnum PIC  X(3).
       01  cnth PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  xhour PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  xminit PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  flt1 PIC S9(4)V9(4) 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;
             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, dml160.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 TEST0859 *******************
             MOVE 1 TO flag

             DISPLAY "                  TEST0859"
             DISPLAY "  <joined table> contained in <select list>"
             DISPLAY "References:"
             DISPLAY "    7.5 SR.4.b -- set function in <join
      -    " condition>"
             DISPLAY "    F# 4 -- Joined table"
             DISPLAY "    F# 47 -- Scalar subquery values"
             DISPLAY "    6.11 LR.2.e"
             DISPLAY "   - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *<join condition> ::= ON <search condition> 

      *Count the number of projects that each employee is working on 
      *that meet certain budgetary criteria 

             DISPLAY "DECLARE C16011 CURSOR FOR"
             DISPLAY "  SELECT EMPNUM, (SELECT COUNT(*) FROM HU.WORKS
      -    " JOIN HU.PROJ"
             DISPLAY "  ON HU.WORKS.PNUM = HU.PROJ.PNUM"
             DISPLAY "  AND BUDGET > AVG (OSTAFF.GRADE) * 1000"
             DISPLAY "  WHERE HU.WORKS.EMPNUM = OSTAFF.EMPNUM) FROM
      -    " HU.STAFF AS OSTAFF"
             DISPLAY "  ORDER BY 2, 1;"
      *  EXEC SQL DECLARE C16011 CURSOR FOR
      *    SELECT EMPNUM, (SELECT COUNT(*) FROM HU.WORKS JOIN
      *  HU.PROJ
      *    ON HU.WORKS.PNUM = HU.PROJ.PNUM
      *    AND BUDGET > AVG (OSTAFF.GRADE) * 1000
      *    WHERE HU.WORKS.EMPNUM = OSTAFF.EMPNUM) FROM HU.STAFF AS
      *  OSTAFF
      *    ORDER BY 2, 1 END-EXEC

             DISPLAY "OPEN C16011;"
      *  EXEC SQL OPEN C16011;
             CALL "SUB3" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxx" TO emnum
             COMPUTE cnth = -1
             DISPLAY "FETCH C16011 INTO :emnum, :cnth;"
      *  EXEC SQL FETCH C16011 INTO :emnum, :cnth;
             CALL "SUB4" USING SQLCODE SQLSTATE emnum cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "emnum should be 'E5 '; its value is '", emnum, "'"
             DISPLAY "cnth should be 0; its value is ", cnth
             if (emnum  NOT  =   "E5 "  OR  cnth  NOT =  0) then
               MOVE 0 TO flag
             END-IF

             MOVE "xxx" TO emnum
             COMPUTE cnth = -1
             DISPLAY "FETCH C16011 INTO :emnum, :cnth;"
      *  EXEC SQL FETCH C16011 INTO :emnum, :cnth;
             CALL "SUB5" USING SQLCODE SQLSTATE emnum cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "emnum should be 'E2 '; its value is '", emnum, "'"
             DISPLAY "cnth should be 1; its value is ", cnth
             if (emnum  NOT  =   "E2 "  OR  cnth  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             MOVE "xxx" TO emnum
             COMPUTE cnth = -1
             DISPLAY "FETCH C16011 INTO :emnum, :cnth;"
      *  EXEC SQL FETCH C16011 INTO :emnum, :cnth;
             CALL "SUB6" USING SQLCODE SQLSTATE emnum cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "emnum should be 'E3 '; its value is '", emnum, "'"
             DISPLAY "cnth should be 1; its value is ", cnth
             if (emnum  NOT  =   "E3 "  OR  cnth  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             MOVE "xxx" TO emnum
             COMPUTE cnth = -1
             DISPLAY "FETCH C16011 INTO :emnum, :cnth;"
      *  EXEC SQL FETCH C16011 INTO :emnum, :cnth;
             CALL "SUB7" USING SQLCODE SQLSTATE emnum cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "emnum should be 'E4 '; its value is '", emnum, "'"
             DISPLAY "cnth should be 2; its value is ", cnth
             if (emnum  NOT  =   "E4 "  OR  cnth  NOT =  2) then
               MOVE 0 TO flag
             END-IF

             MOVE "xxx" TO emnum
             COMPUTE cnth = -1
             DISPLAY "FETCH C16011 INTO :emnum, :cnth;"
      *  EXEC SQL FETCH C16011 INTO :emnum, :cnth;
             CALL "SUB8" USING SQLCODE SQLSTATE emnum cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "emnum should be 'E1 '; its value is '", emnum, "'"
             DISPLAY "cnth should be 4; its value is ", cnth
             if (emnum  NOT  =   "E1 "  OR  cnth  NOT =  4) then
               MOVE 0 TO flag
             END-IF

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

             if ( flag  =  1 ) then
               DISPLAY "                *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0859','pass','MCO');
               CALL "SUB10" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "       dml160.mco  *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0859','fail','MCO');
               CALL "SUB11" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB12" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0859 ********************
      ******************** BEGIN TEST0860 *******************
             MOVE 1 TO flag

             DISPLAY "                  TEST0860"
             DISPLAY "      Domains over various data types"
             DISPLAY "References:"
             DISPLAY "    F# 25 -- Domain definition"
             DISPLAY "    F# 41 -- Time zone specification"
             DISPLAY "    F# 5 -- DATETIME data types"
             DISPLAY "    F# 6 -- VARCHAR data type"
             DISPLAY "    F# 8 -- Union in views"
             DISPLAY "    F# 17 -- Multiple schemas per user"
             DISPLAY "    F# 20 -- CAST functions"
             DISPLAY "   - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *Some people insist on using epochs outside of the traditional 
      *0 to 360 range, so may as well use implementation-defined 
      *precision too. 
             DISPLAY "CREATE DOMAIN EPOCH_NOT_NORM AS DECIMAL (5, 2);"
      *  EXEC SQL CREATE DOMAIN EPOCH_NOT_NORM AS DECIMAL (5, 2)
      * ;
             CALL "SUB13" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *Similar, for people who think in radians 
             DISPLAY "CREATE DOMAIN RAD_EPOCH_TYPE FLOAT (20)"
             DISPLAY "  CHECK (VALUE BETWEEN 0E0 AND 2E0 * 3.1416E0);"
      *  EXEC SQL CREATE DOMAIN RAD_EPOCH_TYPE FLOAT (20)
      *    CHECK (VALUE BETWEEN 0E0 AND 2E0 * 3.1416E0);
             CALL "SUB15" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "CREATE DOMAIN RAD_EPOCH_NOT_NORM REAL;"
      *  EXEC SQL CREATE DOMAIN RAD_EPOCH_NOT_NORM REAL;
             CALL "SUB17" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *We only have data for 1994 through 2025 
             DISPLAY "CREATE DOMAIN TIDEDATE AS DATE"
             DISPLAY "  CHECK (VALUE BETWEEN DATE '1994-01-01' AND DATE
      -    " '2025-12-31');"
      *  EXEC SQL CREATE DOMAIN TIDEDATE AS DATE
      *    CHECK (VALUE BETWEEN DATE '1994-01-01' AND DATE
      *  '2025-12-31');
             CALL "SUB19" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "CREATE DOMAIN TIDETIMESTAMP AS TIMESTAMP WITH TIME
      -    " ZONE"
             DISPLAY "  CHECK (VALUE BETWEEN TIMESTAMP '1994-01-01
      -    " 00:00:00+00:00'"
             DISPLAY "  AND TIMESTAMP '2025-12-31 23:59:59+00:00');"
      *  EXEC SQL CREATE DOMAIN TIDETIMESTAMP AS TIMESTAMP WITH TIME
      *  ZONE
      *    CHECK (VALUE BETWEEN TIMESTAMP '1994-01-01
      *  00:00:00+00:00'
      *    AND TIMESTAMP '2025-12-31 23:59:59+00:00');
             CALL "SUB21" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *...and furthermore, we have very specific notions about dinner.
             DISPLAY "CREATE DOMAIN DINNERTIME AS TIME"
             DISPLAY "  CHECK (VALUE BETWEEN TIME '17:30:00' AND TIME
      -    " '19:00:00');"
      *  EXEC SQL CREATE DOMAIN DINNERTIME AS TIME
      *    CHECK (VALUE BETWEEN TIME '17:30:00' AND TIME '19:00:00')
      * ;
             CALL "SUB23" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *Re-invent the wheel in our default schema because we have non- 
      *normalized data and think in radians.  Eventually the non- 
      *normalized data will be normalized and moved into the main 
      *schema (we hope). 

             DISPLAY "CREATE TABLE CONST_NOT_NORM ("
             DISPLAY "  LOC_ID DEC (7) NOT NULL,"
             DISPLAY "  CONST_ID TIDES.CONST_ID_TYPE NOT NULL,"
             DISPLAY "  UNIQUE (LOC_ID, CONST_ID),"
             DISPLAY "  AMPLITUDE TIDES.AMPLITUDE_TYPE,"
             DISPLAY "  EPOCH EPOCH_NOT_NORM);"
      *  EXEC SQL CREATE TABLE CONST_NOT_NORM (
      *    LOC_ID DEC (7) NOT NULL,
      *    CONST_ID TIDES.CONST_ID_TYPE NOT NULL,
      *    UNIQUE (LOC_ID, CONST_ID),
      *    AMPLITUDE TIDES.AMPLITUDE_TYPE,
      *    EPOCH EPOCH_NOT_NORM);
             CALL "SUB25" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "CREATE VIEW CONST_RAD (LOC_ID, CONST_ID,"
             DISPLAY "  AMPLITUDE, EPOCH) AS"
             DISPLAY "  SELECT LOC_ID, CONST_ID, AMPLITUDE,"
             DISPLAY "  CAST (EPOCH * 3.14159265358979E0 / 180E0 AS
      -    " RAD_EPOCH_TYPE)"
             DISPLAY "  FROM TIDES.CONSTITUENTS;"
      *  EXEC SQL CREATE VIEW CONST_RAD (LOC_ID, CONST_ID,
      *    AMPLITUDE, EPOCH) AS
      *    SELECT LOC_ID, CONST_ID, AMPLITUDE,
      *    CAST (EPOCH * 3.14159265358979E0 / 180E0 AS
      *  RAD_EPOCH_TYPE)
      *    FROM TIDES.CONSTITUENTS;
             CALL "SUB27" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "CREATE VIEW CONST_RAD_NOT_NORM (LOC_ID, CONST_ID,"
             DISPLAY "  AMPLITUDE, EPOCH) AS"
             DISPLAY "  SELECT LOC_ID, CONST_ID, AMPLITUDE,"
             DISPLAY "  CAST (EPOCH * 3.14159265358979E0 / 180E0 AS
      -    " RAD_EPOCH_NOT_NORM)"
             DISPLAY "  FROM CONST_NOT_NORM;"
      *  EXEC SQL CREATE VIEW CONST_RAD_NOT_NORM (LOC_ID, CONST_ID,
      *    AMPLITUDE, EPOCH) AS
      *    SELECT LOC_ID, CONST_ID, AMPLITUDE,
      *    CAST (EPOCH * 3.14159265358979E0 / 180E0 AS
      *  RAD_EPOCH_NOT_NORM)
      *    FROM CONST_NOT_NORM;
             CALL "SUB29" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *List of tide predictions that are pending 

             DISPLAY "CREATE TABLE PENDING ("
             DISPLAY "  LOC_ID DEC (7) NOT NULL,"
             DISPLAY "  FROMTIME TIDETIMESTAMP NOT NULL,"
             DISPLAY "  TOTIME TIDETIMESTAMP NOT NULL,"
             DISPLAY "  CHECK (FROMTIME <= TOTIME),"
             DISPLAY "  JOB_ID INT PRIMARY KEY);"
      *  EXEC SQL CREATE TABLE PENDING (
      *    LOC_ID DEC (7) NOT NULL,
      *    FROMTIME TIDETIMESTAMP NOT NULL,
      *    TOTIME TIDETIMESTAMP NOT NULL,
      *    CHECK (FROMTIME <= TOTIME),
      *    JOB_ID INT PRIMARY KEY);
             CALL "SUB31" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *The data for the starting and ending days are hand-verified 

      *6.10 GR.9.c  Casting timestamp to date throws out the time 
      *part.  Which is good, considering that you can't 
      *EXTRACT (DATE FROM TIDEDATE). 

             DISPLAY "CREATE VIEW CHECK_PTS (CHECK_DATES, JOB_ID, FLAG)
      -    " AS"
             DISPLAY "  SELECT CAST (FROMTIME AS TIDEDATE), JOB_ID,"
             DISPLAY "  CAST (0 AS INT) FROM PENDING"
             DISPLAY "    UNION"
             DISPLAY "  SELECT CAST (TOTIME AS TIDEDATE), JOB_ID,"
             DISPLAY "  CAST (1 AS INT) FROM PENDING;"
      *  EXEC SQL CREATE VIEW CHECK_PTS (CHECK_DATES, JOB_ID, FLAG)
      *  AS
      *    SELECT CAST (FROMTIME AS TIDEDATE), JOB_ID,
      *    CAST (0 AS INT) FROM PENDING
      *    UNION
      *    SELECT CAST (TOTIME AS TIDEDATE), JOB_ID,
      *    CAST (1 AS INT) FROM PENDING;
             CALL "SUB33" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "CREATE TABLE DINNER_CLUB ("
             DISPLAY "  LOC_ID DEC (7) NOT NULL,"
             DISPLAY "  DINNER DINNERTIME);"
      *  EXEC SQL CREATE TABLE DINNER_CLUB (
      *    LOC_ID DEC (7) NOT NULL,
      *    DINNER DINNERTIME);
             CALL "SUB35" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

      *First try out the DOUBLE PRECISION and INTERVAL domains that ar
      *already in TIDES. 

             MOVE 500 TO xhour
             MOVE 500 TO xminit
             DISPLAY "SELECT EXTRACT (HOUR FROM MERIDIAN), EXTRACT"
             DISPLAY "  (MINUTE FROM MERIDIAN) INTO :xhour, :xminit"
             DISPLAY "  FROM TIDES.LOCATIONS WHERE LOC_NAME LIKE '", ,
             "ewfound"";"
      *  EXEC SQL SELECT EXTRACT (HOUR FROM MERIDIAN), EXTRACT
      *    (MINUTE FROM MERIDIAN) INTO :xhour, :xminit
      *    FROM TIDES.LOCATIONS WHERE LOC_NAME LIKE '%Newfound%'
      * ;
             CALL "SUB37" USING SQLCODE SQLSTATE xhour xminit
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
      *Sign of results specified by 6.6 GR.3.a.i 
             DISPLAY "xhour should be -3; its value is ", xhour
             DISPLAY "xminit should be -30; its value is ", xminit
             if (xhour  NOT =  -3  OR  xminit  NOT =  -30) then
               MOVE 0 TO flag
             END-IF

      *There is no GMT-13.  Violation of domain constraint 9.2 GR.4 
      *Integrity constraint violation 

             DISPLAY "INSERT INTO TIDES.LOCATIONS VALUES ("
             DISPLAY "  300, 'Atlantis', 160.0000, 3.0000, 0, 1.2E0,"
             DISPLAY "  INTERVAL -'13:00' HOUR TO MINUTE, 'GMT-13');"
      *  EXEC SQL INSERT INTO TIDES.LOCATIONS VALUES (
      *    300, 'Atlantis', 160.0000, 3.0000, 0, 1.2E0,
      *    INTERVAL -'13:00' HOUR TO MINUTE, 'GMT-13');
             CALL "SUB38" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000"then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "23000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

      *Negative amplitudes also illegal 

             DISPLAY "UPDATE TIDES.CONSTITUENTS"
             DISPLAY "  SET AMPLITUDE = - AMPLITUDE"
             DISPLAY "  WHERE LOC_ID = 100"
             DISPLAY "  AND CONST_ID = 0;"
      *  EXEC SQL UPDATE TIDES.CONSTITUENTS
      *    SET AMPLITUDE = - AMPLITUDE
      *    WHERE LOC_ID = 100
      *    AND CONST_ID = 0;
             CALL "SUB39" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000"then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "23000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

             DISPLAY "INSERT INTO TIDES.LOCATIONS VALUES (300,"
             DISPLAY "   'Bath, Maine', -69.8133, 43.9183,"
             DISPLAY "   1, 3.422E0, INTERVAL '-05:00' HOUR TO MINUTE,
      -    " ':US/Eastern');"
      *  EXEC SQL INSERT INTO TIDES.LOCATIONS VALUES (300,
      *    'Bath, Maine', -69.8133, 43.9183,
      *    1, 3.422E0, INTERVAL '-05:00' HOUR TO MINUTE,
      *  ':US/Eastern');
             CALL "SUB40" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Check constraint on normalized table 

             DISPLAY "INSERT INTO TIDES.CONSTITUENTS VALUES (300, 2,
      -    " 0.134E0, 385.0);"
      *  EXEC SQL INSERT INTO TIDES.CONSTITUENTS VALUES (300, 2,
      *  0.134E0, 385.0);
             CALL "SUB41" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000"then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "23000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

      *Load up some non-normalized data 

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 0,
      -    " 0.021E0, 151.6);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 0,
      *  0.021E0, 151.6);
             CALL "SUB42" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 1,
      -    " 0.324E0, 144.5);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 1,
      *  0.324E0, 144.5);
             CALL "SUB43" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 2,
      -    " 0.134E0, 385.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 2,
      *  0.134E0, 385.0);
             CALL "SUB44" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 3,
      -    " 0.181E0, 40.9);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 3,
      *  0.181E0, 40.9);
             CALL "SUB45" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 4,
      -    " 0.037E0, 150.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 4,
      *  0.037E0, 150.0);
             CALL "SUB46" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 5,
      -    " 3.143E0, 352.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 5,
      *  3.143E0, 352.3);
             CALL "SUB47" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 6,
      -    " 0.000E0, 50.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 6,
      *  0.000E0, 50.0);
             CALL "SUB48" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 7,
      -    " 0.104E0, 242.8);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 7,
      *  0.104E0, 242.8);
             CALL "SUB49" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 8,
      -    " 0.031E0, 158.6);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 8,
      *  0.031E0, 158.6);
             CALL "SUB50" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 9,
      -    " 0.000E0, 133.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 9,
      *  0.000E0, 133.3);
             CALL "SUB51" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 10,
      -    " 0.744E0, 322.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 10,
      *  0.744E0, 322.0);
             CALL "SUB52" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 11,
      -    " 0.087E0, 307.4);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 11,
      *  0.087E0, 307.4);
             CALL "SUB53" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 12,
      -    " 0.260E0, 130.4);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 12,
      *  0.260E0, 130.4);
             CALL "SUB54" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 13,
      -    " 0.011E0, 158.7);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 13,
      *  0.011E0, 158.7);
             CALL "SUB55" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 14,
      -    " 0.107E0, 140.8);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 14,
      *  0.107E0, 140.8);
             CALL "SUB56" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 15,
      -    " 0.043E0, 114.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 15,
      *  0.043E0, 114.3);
             CALL "SUB57" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 16,
      -    " 0.007E0, 116.4);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 16,
      *  0.007E0, 116.4);
             CALL "SUB58" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 17,
      -    " 0.004E0, 383.2);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 17,
      *  0.004E0, 383.2);
             CALL "SUB59" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 18,
      -    " 0.000E0, 17.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 18,
      *  0.000E0, 17.3);
             CALL "SUB60" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 19,
      -    " 0.488E0, 383.4);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 19,
      *  0.488E0, 383.4);
             CALL "SUB61" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 20,
      -    " 0.000E0, 69.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 20,
      *  0.000E0, 69.0);
             CALL "SUB62" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 21,
      -    " 0.000E0, 103.5);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 21,
      *  0.000E0, 103.5);
             CALL "SUB63" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 22,
      -    " 0.053E0, 365.8);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 22,
      *  0.053E0, 365.8);
             CALL "SUB64" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 23,
      -    " 0.053E0, 37.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 23,
      *  0.053E0, 37.3);
             CALL "SUB65" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 24,
      -    " 0.023E0, 297.8);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 24,
      *  0.023E0, 297.8);
             CALL "SUB66" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 25,
      -    " 0.138E0, 328.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 25,
      *  0.138E0, 328.3);
             CALL "SUB67" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 26,
      -    " 0.010E0, 124.4);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 26,
      *  0.010E0, 124.4);
             CALL "SUB68" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 27,
      -    " 0.000E0, 50.6);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 27,
      *  0.000E0, 50.6);
             CALL "SUB69" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 28,
      -    " 0.000E0, 49.4);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 28,
      *  0.000E0, 49.4);
             CALL "SUB70" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 29,
      -    " 0.000E0, 66.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 29,
      *  0.000E0, 66.0);
             CALL "SUB71" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 30,
      -    " 0.000E0, 67.8);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 30,
      *  0.000E0, 67.8);
             CALL "SUB72" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 31,
      -    " 0.000E0, 35.7);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 31,
      *  0.000E0, 35.7);
             CALL "SUB73" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 32,
      -    " 0.073E0, 285.0);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 32,
      *  0.073E0, 285.0);
             CALL "SUB74" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 33,
      -    " 0.033E0, 257.3);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 33,
      *  0.033E0, 257.3);
             CALL "SUB75" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 34,
      -    " 0.000E0, 0.6);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 34,
      *  0.000E0, 0.6);
             CALL "SUB76" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 35,
      -    " 0.056E0, 128.8);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 35,
      *  0.056E0, 128.8);
             CALL "SUB77" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO CONST_NOT_NORM VALUES (300, 36,
      -    " 0.038E0, 97.7);"
      *  EXEC SQL INSERT INTO CONST_NOT_NORM VALUES (300, 36,
      *  0.038E0, 97.7);
             CALL "SUB78" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 0.0 TO flt1
             DISPLAY "SELECT EPOCH INTO :flt1 FROM CONST_RAD"
             DISPLAY "  WHERE LOC_ID = 100"
             DISPLAY "  AND CONST_ID = 0;"
      *  EXEC SQL SELECT EPOCH INTO :flt1 FROM CONST_RAD
      *    WHERE LOC_ID = 100
      *    AND CONST_ID = 0;
             CALL "SUB79" USING SQLCODE SQLSTATE flt1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "flt1 should be 2.11 += 0.01; its value is ", flt1
             if (flt1  <  2.10  OR  flt1  >  2.12) then
               MOVE 0 TO flag
             END-IF

             COMPUTE cnth = -1
             DISPLAY "SELECT COUNT(*) INTO :cnth"
             DISPLAY "  FROM CONST_RAD_NOT_NORM"
             DISPLAY "  WHERE EPOCH > 6.2831853E0;"
      *  EXEC SQL SELECT COUNT(*) INTO :cnth
      *    FROM CONST_RAD_NOT_NORM
      *    WHERE EPOCH > 6.2831853E0;
             CALL "SUB80" USING SQLCODE SQLSTATE cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cnth should be 4; its value is ", cnth
             if (cnth  NOT =  4) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "INSERT INTO PENDING VALUES ("
             DISPLAY "  300, TIMESTAMP '1995-12-15 00:00:00-05:00',"
             DISPLAY "       TIMESTAMP '1995-12-17 00:00:00-05:00', 0);"
      *  EXEC SQL INSERT INTO PENDING VALUES (
      *    300, TIMESTAMP '1995-12-15 00:00:00-05:00',
      *    TIMESTAMP '1995-12-17 00:00:00-05:00', 0);
             CALL "SUB81" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Check that constraint. 
      *7PM EST is 12AM GMT, which is outside the constraint 

             DISPLAY "INSERT INTO PENDING VALUES ("
             DISPLAY "  101, TIMESTAMP '2025-12-30 19:00:00-05:00',"
             DISPLAY "       TIMESTAMP '2025-12-31 19:00:00-05:00', 1);"
      *  EXEC SQL INSERT INTO PENDING VALUES (
      *    101, TIMESTAMP '2025-12-30 19:00:00-05:00',
      *    TIMESTAMP '2025-12-31 19:00:00-05:00', 1);
             CALL "SUB82" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000"then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "23000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

             DISPLAY "INSERT INTO PENDING VALUES ("
             DISPLAY "  101, TIMESTAMP '2025-12-30 19:00:00-05:00',"
             DISPLAY "       TIMESTAMP '2025-12-31 18:59:59-05:00', 1);"
      *  EXEC SQL INSERT INTO PENDING VALUES (
      *    101, TIMESTAMP '2025-12-30 19:00:00-05:00',
      *    TIMESTAMP '2025-12-31 18:59:59-05:00', 1);
             CALL "SUB83" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO PENDING VALUES ("
             DISPLAY "  102, TIMESTAMP '1993-12-31 19:00:00-05:00',"
             DISPLAY "       TIMESTAMP '1994-01-02 00:00:00-05:00', 2);"
      *  EXEC SQL INSERT INTO PENDING VALUES (
      *    102, TIMESTAMP '1993-12-31 19:00:00-05:00',
      *    TIMESTAMP '1994-01-02 00:00:00-05:00', 2);
             CALL "SUB84" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *1993-12-31 19:00:00-05:00 is within the constraint because it's
      *midnight GMT.  Unfortunately, when we cast it to TIDEDATE, 
      *it ends up being just 1993-12-31, which does not meet the 
      *constraint.  6.10 GR.9.c 

             DISPLAY "SELECT EXTRACT (YEAR FROM CHECK_DATES)"
             DISPLAY "  INTO :cnth"
             DISPLAY "  FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 0;"
      *  EXEC SQL SELECT EXTRACT (YEAR FROM CHECK_DATES)
      *    INTO :cnth
      *    FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 0;
             CALL "SUB85" USING SQLCODE SQLSTATE cnth
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000"then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "23000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

             COMPUTE cnth = -1
             DISPLAY "SELECT EXTRACT (YEAR FROM CHECK_DATES)"
             DISPLAY "  INTO :cnth"
             DISPLAY "  FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 1;"
      *  EXEC SQL SELECT EXTRACT (YEAR FROM CHECK_DATES)
      *    INTO :cnth
      *    FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 1;
             CALL "SUB86" USING SQLCODE SQLSTATE cnth
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cnth should be 1994; its value is ", cnth
             if (cnth  NOT =  1994) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "INSERT INTO DINNER_CLUB VALUES"
             DISPLAY "  (0, TIME '17:30:00');"
      *  EXEC SQL INSERT INTO DINNER_CLUB VALUES
      *    (0, TIME '17:30:00');
             CALL "SUB87" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO DINNER_CLUB VALUES"
             DISPLAY "  (1, CAST (TIME '18:00:00' AS DINNERTIME));"
      *  EXEC SQL INSERT INTO DINNER_CLUB VALUES
      *    (1, CAST (TIME '18:00:00' AS DINNERTIME));
             CALL "SUB88" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO DINNER_CLUB VALUES"
             DISPLAY "  (2, TIME '19:30:00');"
      *  EXEC SQL INSERT INTO DINNER_CLUB VALUES
      *    (2, TIME '19:30:00');
             CALL "SUB89" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000"then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "23000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

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

      *Clean up the mess 

             DISPLAY "DROP DOMAIN EPOCH_NOT_NORM CASCADE;"
      *  EXEC SQL DROP DOMAIN EPOCH_NOT_NORM CASCADE;
             CALL "SUB91" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP DOMAIN RAD_EPOCH_TYPE CASCADE;"
      *  EXEC SQL DROP DOMAIN RAD_EPOCH_TYPE CASCADE;
             CALL "SUB93" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP DOMAIN RAD_EPOCH_NOT_NORM CASCADE;"
      *  EXEC SQL DROP DOMAIN RAD_EPOCH_NOT_NORM CASCADE;
             CALL "SUB95" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP DOMAIN TIDEDATE CASCADE;"
      *  EXEC SQL DROP DOMAIN TIDEDATE CASCADE;
             CALL "SUB97" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP DOMAIN TIDETIMESTAMP CASCADE;"
      *  EXEC SQL DROP DOMAIN TIDETIMESTAMP CASCADE;
             CALL "SUB99" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP DOMAIN DINNERTIME CASCADE;"
      *  EXEC SQL DROP DOMAIN DINNERTIME CASCADE;
             CALL "SUB101" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP TABLE CONST_NOT_NORM CASCADE;"
      *  EXEC SQL DROP TABLE CONST_NOT_NORM CASCADE;
             CALL "SUB103" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP VIEW CONST_RAD CASCADE;"
      *  EXEC SQL DROP VIEW CONST_RAD CASCADE;
             CALL "SUB105" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP TABLE PENDING CASCADE;"
      *  EXEC SQL DROP TABLE PENDING CASCADE;
             CALL "SUB107" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DROP TABLE DINNER_CLUB CASCADE;"
      *  EXEC SQL DROP TABLE DINNER_CLUB CASCADE;
             CALL "SUB109" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "DELETE FROM TIDES.LOCATIONS"
             DISPLAY "  WHERE LOC_ID = 300;"
      *  EXEC SQL DELETE FROM TIDES.LOCATIONS
      *    WHERE LOC_ID = 300;
             CALL "SUB111" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             if ( flag  =  1 ) then
               DISPLAY "                *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0860','pass','MCO');
               CALL "SUB113" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "       dml160.mco  *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0860','fail','MCO');
               CALL "SUB114" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB115" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0860 ********************
      **** 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.

Messung V0.5 in Prozent
C=77 H=100 G=89

¤ Dauer der Verarbeitung: 0.25 Sekunden  (vorverarbeitet am  2026-04-26) ¤

*© Formatika GbR, Deutschland






Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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 und die Messung sind noch experimentell.






                                                                                                                                                                                                                                                                                                                                                                                                     


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

Monitoring

Montastic status badge