Quellcode-Bibliothek

^© Kompilation durch diese Firma

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

Datei: reporta.cob Sprache: Cobol

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

      * EMBEDDED COBOL ("file REPORTA.PCO")

      ****************************************************************
      *
      *                COMMENT SECTION
      * 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.
      *
      *
      * WRITTEN BY:  J. Sullivan
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      *
      * This routine populates the tables R_STRUCTURE and T_REQ
      * and lists programs to be executed for each BINDING_CLAIMED.
      * This list is not needed for testing a common profile such
      * as Entry FIPS 127-2, Transitional FIPS 127-2, FIPS Sizing,
      * X/Open with IEF, or X/Open without IEF, because a canned
      * list is provided for each common profile.
      *
      *
      * BACKGROUND:
      * The test numbers to be run are derived from the
      * FEATURE_CLAIMED table.
      * The derivation is recursive, based on links in table
      * IMPLICATION.  Profiles contain subprofiles (recursively)
      * which contain features (eventually).
      * The derived features are joined with table TESTFEATRUE (which
      * links tests to features) to populate table R_STRUCTURE
      * (report structure), a list of tests for each FEATURE_CLAIMED.
      * T_REQ contains the product of R_STRUCTURE and BINDING_CLAIMED
      * Each row represents a test required for a binding claimed.
      * The status column REQOPTNA of T_REQ is updated through
      * program logic (SQL "rules") to values REQ, OPT, or NA
      *
      * A TEd file is generated to specify delete of extraneous
      * tests (from the list of programs to be executed).
      * This list is not needed for testing common profiles.
      *
      * Debugging is turned on by setting debug1 = 1
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  prog PIC  X(6).
       01  tpnote PIC  X(10).
       01  testno PIC  X(4).
       01  feat1 PIC  X(4).
       01  feat2 PIC  X(4).
       01  feat3 PIC  X(4).
       01  featur PIC  X(32).
       01  bind1 PIC  X(3).
       01  reqopt PIC  X(3).
       01  result PIC  X(4).
       01  iii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  lvl PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  SQLSTATE PIC  X(5).
       01  SQLCODE PIC S9(9) COMP.
             EXEC SQL END DECLARE SECTION END-EXEC
       01  indivt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  bindlc PIC  X(3).
       01  bind0 PIC  X(3).
       01  errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  loopct PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  debug1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *date_time declaration
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).

       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       PROCEDURE DIVISION.
       P0.

             MOVE "HU " 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
             if (uid  NOT  =   uidx) then
               DISPLAY "ERROR: User ", uid, " expected. User ", uidx, "
      -    " connected"
            STOP RUN
             END-IF
             DISPLAY
           "SQL Test Suite, V6.0, Embedded COBOL, reporta.pco"
             DISPLAY
           "59-byte ID"
             DISPLAY "TEd Version #"

      *date_time print
           ACCEPT TO-DAY FROM DATE
           ACCEPT THE-TIME FROM TIME
             DISPLAY " "
           DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME

             MOVE 0 TO errcnt

      *to debug program, set debug1 = 1
             MOVE 0 TO debug1

      *Profile P998 will set indivt = 1
             MOVE 0 TO indivt

      ****************************************************************

             EXEC SQL DECLARE SHOW_CLAIM CURSOR FOR
               SELECT REPORTFEATURE.FEATURE1, FEATURENAME, BINDING1
               FROM FEATURE_CLAIMED, REPORTFEATURE, BINDING_CLAIMED
               WHERE REPORTFEATURE.FEATURE1
               = FEATURE_CLAIMED.FEATURE1
               ORDER BY 1, 2, 3 END-EXEC
             EXEC SQL OPEN SHOW_CLAIM END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " "
             DISPLAY "These are the profiles and bindings to be tested:"
             MOVE 0 TO SQLCODE
             MOVE 0 TO iii
           .
        P250.
             EXEC SQL FETCH SHOW_CLAIM INTO :feat1, :featur, :bind1
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0  OR  SQLCODE  =  100) then
               GO TO P252
             END-IF
      *X/Open profiles do not exist for bindings other than PC and PCO
             if (bind1   =   "PC "  OR  bind1   =   "PCO" ) then
               GO TO P251
             END-IF
             if (feat1   =   "P210" ) then
               GO TO P250
             END-IF
             if (feat1   =   "P230" ) then
               GO TO P250
             END-IF

           .
        P251.
             if (bind1   =   "P998") then
               MOVE 1 TO indivt
             END-IF
             COMPUTE iii = iii + 1
             DISPLAY feat1, " ", bind1, " ", featur
             GO TO P250

           .
        P252.
             EXEC SQL CLOSE SHOW_CLAIM END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY iii, " claim(s) selected"
             if (iii  =  0) then
               DISPLAY "Either BINDING_CLAIMED or FEATURE_CLAIMED is
      -    " empty!"
               DISPLAY "You must INSERT at least one row into each
      -    " table."
               DISPLAY "See instructions in file other/report_l.doc"
               GO TO P411
             END-IF

      ****************************************************************

             DISPLAY  " "
             DISPLAY "REPORTA step 1: Check to make sure that each test
      -    " number"
             DISPLAY " is linked to the reporting
      -    " structure;"
             DISPLAY " i.e., that each TESTCASE row has
      -    " at"
             DISPLAY " least one TESTFEATURE row."
             EXEC SQL DECLARE ERROR1 CURSOR FOR
               SELECT TESTNO
               FROM TESTCASE
               WHERE TESTNO NOT IN
               (SELECT TESTNO FROM TESTFEATURE)
               ORDER BY TESTNO END-EXEC
             EXEC SQL OPEN ERROR1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE 0 TO iii
           .
        P120.
             EXEC SQL FETCH ERROR1 INTO :testno END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               DISPLAY "FETCH ERROR1 SQLCODE = ", SQL-COD, " "
             END-IF
             if (SQLCODE  <  0  OR  SQLCODE  =  100) then
               GO TO P121
             END-IF
             COMPUTE iii = iii + 1
             DISPLAY "TESTCASE without TESTFEATURE row: ", testno
             GO TO P120
           .
        P121.
             EXEC SQL CLOSE ERROR1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (iii  >  0) then
               COMPUTE errcnt = errcnt + 1
               DISPLAY "#ERR1 reference-coding error. TESTFEATURE rows
      -    " missing!"
               PERFORM PFTEMP THRU P220
      *Suicide note #1
             END-IF

      *=========================================================
      *Recursive derivation of features to be tested
      *=========================================================
      *The goal is for table F_REQ to contain a row for each
      *feature implied by a row in table FEATURE_CLAIMED.
      *In general, each FEATURE_CLAIMED is a profile
      *(begins with the letter P) as opposed to an individual
      *feature (begins with a digit).

      *Each profile in FEATURE_CLAIMED will generate 3 reports.

      *This reporting structure allows individual features to
      *be claimed; although, it is not expected that this
      *form of reporting will be commonly used in validations.
      *All the individual features in FEATURE_CLAIMED will
      *be grouped together in a pseudo profile, P998, under the
      *heading "Individual Features," for ease in reporting.

      *After the recursive process below, each individual
      *feature required for testing will be represented in
      *F_REQ column F1.  The C1 column ("claim") will contain
      *the value from the table FEATURE_CLAIMED (except for
      *individual features claimed, which will have C1 value
      *'P998').  The P1 column is the immediate profile of
      *the F1 column.  For example, if FEATURE_CLAIMED has
      *a row with value 'P135' for Transitional SQL, then
      *many features will be derived, among them '0IEF', and
      *there will be a F_REQ row with (C1, P1, F1) values:
      *  C1 = 'P135'   "claimed" Transitional SQL
      *  P1 = 'P120'   "immediate profile" Entry SQL
      *  F1 = '0IEF'   "feature" IEF
      *In the rare case that '0IEF' is claimed as an individual
      *feature to be tested, by inserting value '0IEF' in table
      *FEATURE_CLAIMED, then F_REQ would have a row with
      *(C1, P1, F1) values  ('P998','0IEF','0IEF').

             DISPLAY  " "
             DISPLAY "REPORTA step 2: Derive all features to be
      -    " tested."

      *setup
             EXEC SQL DELETE FROM F_REQ END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL DELETE FROM F_TEMP END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *#step 1#
      *Begin work on the features claimed.
      *FEATURE1 is either an individual feature or (most likely) a pro
      *Individual features claimed will be inserted into table F_REQ,
      *and they need no more processing.
      *P998 is the report category "Individual Features".

      *Everything else (profiles) needs more processing (recursion),
      *and they will be inserted into table F_TEMP.
             MOVE 0 TO iii

             EXEC SQL INSERT INTO F_REQ
               SELECT 'P998',FEATURE1,FEATURE1,0
               FROM FEATURE_CLAIMED
               WHERE FEATURE1 NOT LIKE 'P%' END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #1 INSERT INTO F_REQ, SQLCODE = ",
             SQL-COD
             END-IF
             if (SQLCODE  =  100) then
               COMPUTE iii = iii + 1
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (debug1  =  1) then
               DISPLAY "Table F_REQ with individual features claimed:"
               PERFORM PFREQ THRU P210
             END-IF

      *#step 2#
      *set up initial C1, P1 values for profiles.

      *If F_REQ.F1 is a profile (begins with "P"),
      *move the FEATURE_CLAIMED value to all columns
      *and prepare to recurse.

             EXEC SQL INSERT INTO F_TEMP
               SELECT FEATURE1,FEATURE1,FEATURE1,1
               FROM FEATURE_CLAIMED
               WHERE FEATURE1 LIKE 'P%'
               AND FEATURE1 <> 'P998' END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #2 INSERT INTO F_TEMP, SQLCODE = ",
             SQL-COD
             END-IF
             if (SQLCODE  =  100) then
               COMPUTE iii = iii + 1
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *We now have individual features table in F_REQ and
      *profiles in table F_TEMP.

             if (debug1  =  1) then
               DISPLAY "Table F_TEMP with profiles claimed:"
               PERFORM PFTEMP THRU P220
             END-IF

             if (iii  =  2) then
               DISPLAY "Table FEATURE_CLAIMED is empty!"
               DISPLAY "User MUST specify profiles to test by"
               DISPLAY " inserting value(s) into table FEATURE_CLAIMED."
             END-IF

             MOVE 0 TO loopct

           .
        P100.

             COMPUTE loopct = loopct + 1

      *#step 3#
      *recurse here, until done.

      *#step 3a#
      *Generate the next level in the hierarchy,
      *keeping the first two columns and replacing the link.
      *Rows are optimistically sent back to F_REQ, assuming that
      *the recursion is complete.  If it isn't, we'll move the
      *rows with profiles out again to recurse another level.

             EXEC SQL INSERT INTO F_REQ
               SELECT C1,P1,CHILD_F,LVL
               FROM F_TEMP, IMPLICATION
               WHERE F1 = PARENT_F END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #4 INSERT INTO F_REQ, SQLCODE = ",
             SQL-COD
             END-IF

             EXEC SQL DELETE FROM F_TEMP WHERE F1 IN
               (SELECT PARENT_F FROM IMPLICATION) END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #5 DELETE FROM F_TEMP, SQLCODE = ",
             SQL-COD
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *We have now moved every F_TEMP row back into F_REQ,
      *after replacing the F1 profile value with its "child."
      *The "child" is either a profile or a feature.

             if (debug1  =  1) then
               DISPLAY "Table F_REQ after ", loopct, " recursion(s)"
               PERFORM PFREQ THRU P210
               DISPLAY "Table F_TEMP after ", loopct, " recursion(s)"
               DISPLAY "Table F_TEMP should be empty"
               PERFORM PFTEMP THRU P220
             END-IF

             MOVE 1 TO iii
             EXEC SQL SELECT COUNT(*) INTO :iii FROM F_TEMP END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (iii  >  0  OR  SQLCODE  <  0  OR  SQLCODE  =  100) then
               COMPUTE errcnt = errcnt + 1
               DISPLAY "#ERR2 reference-coding error. F_TEMP not empty!"
               PERFORM PFTEMP THRU P220
      *Suicide note #2
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *It's a reference-coding error if F_TEMP has any rows at all.
      *F_TEMP contains only profiles without features.
      *so, F_TEMP should be empty.

      *#step 3b#
      *If F_REQ.F1 is a profile (begins with "P"),
      *move the profile values from F_REQ to F_TEMP
      *and prepare to recurse.
      *The child feature from the next level of recursion will belong
      *to both the grandparent feature and the parent feature.
      *Column LVL is the level of recursion for column F1.

             EXEC SQL INSERT INTO F_TEMP
               SELECT C1,F1,F1,LVL+1
               FROM F_REQ
               WHERE F1 LIKE 'P%' END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #7a INSERT INTO F_TEMP, SQLCODE = ",
             SQL-COD
             END-IF

             EXEC SQL INSERT INTO F_TEMP
               SELECT C1,P1,F1,LVL
               FROM F_REQ
               WHERE F1 LIKE 'P%' END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #7b INSERT INTO F_TEMP, SQLCODE = ",
             SQL-COD
             END-IF

             EXEC SQL DELETE FROM F_REQ
               WHERE F1 LIKE 'P%' END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #8 DELETE FROM F_REQ, SQLCODE = ",
             SQL-COD
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *We now have individual features in F_REQ and
      *profiles in table F_TEMP.

             if (debug1  =  1) then
               DISPLAY "Table F_REQ with features derived at this
      -    " point:"
               PERFORM PFREQ THRU P210
               DISPLAY "Table F_TEMP with profiles for next recursion:"
               PERFORM PFTEMP THRU P220
             END-IF

             MOVE 0 TO iii
             EXEC SQL SELECT COUNT(*) INTO :iii FROM F_TEMP END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *It's time to quit if F_TEMP is empty;
      *otherwise, continue the recursion.

             if (iii  >  0) then
               GO TO P100
             END-IF
             if (loopct  =  1) then
               DISPLAY "Recursion exhausted after 1 pass."
             else
               DISPLAY "Recursion exhausted after ", loopct, " passes."
             END-IF

      *=========================================================
      *Determine which tests are required for the derived features
      *=========================================================

             DISPLAY  " "
             DISPLAY "REPORTA step 3: Determine which tests are
      -    " required."

      *set up
             EXEC SQL DELETE FROM R_STRUCTURE END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      *Find all related tests
      *Replace feature with TESTNO:
             EXEC SQL INSERT INTO R_STRUCTURE
               SELECT DISTINCT C1, P1, TESTNO, LVL
               FROM F_REQ, TESTFEATURE
               WHERE FEATURE1 = F1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               DISPLAY "Problem #9 INSERT INTO R_STRUCTURE, SQLCODE = ",
             SQL-COD
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (debug1  =  1) then
               DISPLAY "Table R_STRUCTURE with all related tests:"
               PERFORM PRSTR THRU P230
             END-IF

      *Drop related tests not fully supported by combined claims:
             EXEC SQL DELETE FROM R_STRUCTURE
               WHERE TESTNO IN
               (SELECT TESTNO FROM TESTFEATURE
               WHERE FEATURE1 NOT IN
               (SELECT F1 FROM F_REQ)) END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #10 DELETE FROM R_STRUCTURE, SQLCODE =
      -    " ", SQL-COD
             END-IF
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               DISPLAY "Partially supported tests WERE DELETED."
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (debug1  =  1) then
               DISPLAY "Table R_STRUCTURE with all fully supported
      -    " tests:"
               PERFORM PRSTR THRU P230
             END-IF

      *One big happy profile when indivt = 1.
      *Every test will print under every profile
      *  for which it has at least one feature,
      *  provided the entire test is supported by the entire profile.
             if (indivt  =  1) then
               GO TO P150
             END-IF

      *Drop tests not fully supported in each subprofile.
      *This will give stable counts to each subprofile (except P998).

             EXEC SQL DELETE FROM R_STRUCTURE
               WHERE C1 <> 'P998'
               AND TESTNO IN
               (SELECT TESTNO FROM TESTFEATURE
               WHERE FEATURE1 NOT IN
               (SELECT F1 FROM F_REQ
               WHERE F_REQ.C1 = R_STRUCTURE.C1
               AND F_REQ.P1 = R_STRUCTURE.P1)) END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #11a UPDATE R_STRUCTURE, SQLCODE = ",
             SQL-COD
             END-IF
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               DISPLAY "Some tests were not fully contained in a
      -    " subprofile."
             END-IF

      *Identify each tests's highest level within its profile.
      *F_TEMP column P1 is holding TESTNO values.

             EXEC SQL INSERT INTO F_TEMP (C1, P1, LVL)
               SELECT C1, TESTNO, MAX (LVL)
               FROM R_STRUCTURE
               GROUP BY C1, TESTNO END-EXEC
             MOVE SQLCODE TO SQL-COD

      *For duplicate testno within a profile, drop lowest subprofile.
      *F_TEMP column P1 is holding TESTNO values.

             EXEC SQL DELETE FROM R_STRUCTURE
               WHERE C1 <> 'P998'
               AND NOT EXISTS (SELECT * FROM F_TEMP
               WHERE F_TEMP.C1 = R_STRUCTURE.C1
               AND F_TEMP.P1 = R_STRUCTURE.TESTNO
               AND F_TEMP.LVL = R_STRUCTURE.LVL) END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #11b DELETE FROM R_STRUCTURE, SQLCODE =
      -    " ", SQL-COD
             END-IF

           .
        P150.

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (debug1  =  1) then
               DISPLAY "Table R_STRUCTURE with P998 resolved:"
               PERFORM PRSTR THRU P230
             END-IF

      *Note that R_STRUCTURE now has the full reporting structure.
      *Some tests will be reported in more than one profile.

      *=========================================================
      *Multiply tests required by bindings claimed.
      *And pick up TESTNO's program name.
      *=========================================================

             DISPLAY  " "
             DISPLAY "REPORTA step 4: Multiply tests required by
      -    " bindings claimed."
      *set up
             EXEC SQL DELETE FROM T_REQ END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO T_REQ
               SELECT DISTINCT TESTCASE.TESTNO, TESTCASE.PROG,
               BINDING1, 'REQ', ' '
               FROM TESTCASE, R_STRUCTURE, BINDING_CLAIMED
               WHERE TESTCASE.TESTNO = R_STRUCTURE.TESTNO END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (SQLCODE  <  0) then
               DISPLAY "Problem #12 INSERT INTO T_REQ, SQLCODE = ",
             SQL-COD
             END-IF
             if (SQLCODE  =  100) then
               DISPLAY "Table FEATURE_CLAIMED or BINDING_CLAIMED is
      -    " empty!"
               DISPLAY "User MUST specify bindings to test by"
               DISPLAY " inserting value(s) into table BINDING_CLAIMED."
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (debug1  =  1) then
               DISPLAY "Before setting value of column REQOPTNA"
               PERFORM PTREQ THRU P240
             END-IF

      *=========================================================
      *Mark 'NA' each test not required for certain bindings
      *Mark 'DL','UR','WD' tests deleted, under review, withdrawn
      *=========================================================

             DISPLAY  " "
             DISPLAY "REPORTA step 5: Mark 'NA' tests which do not
      -    " exist for a particular"
             DISPLAY " language."

      *For Version 5.1, which does not yet contain translations for
      * Transitional SQL tests in the interfaces for
      * Module FORTRAN, Embedded Pascal, and Module Pascal:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 IN ('PPA','MFO','MPA')
               AND TESTNO > '0555'
               AND TESTNO <> '0564'
               AND PROG NOT BETWEEN 'flg010' AND 'flg013' END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For X/Open Testing, which has only PC and PCO bindings:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 <> 'PC' AND BINDING1 <> 'PCO'
               AND PROG LIKE 'xop%' END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'PC'
               AND TESTNO IN ('0712','0724','0725') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For the language-specific programs:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE PROG LIKE 'cob%' AND BINDING1 <> 'PCO'
               AND BINDING1 <> 'MCO'
               OR PROG LIKE 'for%' AND BINDING1 <> 'PFO'
               AND BINDING1 <> 'MFO'
               OR PROG LIKE 'ccc%' AND BINDING1 <> 'PC'
               AND BINDING1 <> 'MC'
               OR PROG LIKE 'pas%' AND BINDING1 <> 'PPA'
               AND BINDING1 <> 'MPA'
               OR PROG LIKE 'ada%' AND BINDING1 <> 'PAD'
               AND BINDING1 <> 'MAD'
               OR PROG LIKE 'sql%' AND BINDING1 <> 'SQL' END-EXEC
             MOVE SQLCODE TO SQL-COD

      *If we have MUMPS or PLI tests, we will add the following:
      *OR PROG LIKE 'pli%' AND BINDING1 <> 'PPL' AND BINDING1 <> 'MPL'
      *OR PROG LIKE 'mum%' AND BINDING1 <> 'PMU' AND BINDING1 <> 'MMU'

      * For the NON-module language interfaces:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 NOT LIKE 'M%'
               AND PROG     IN ('dml074','dml088','yts814') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For the NON-embedded interfaces:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 NOT LIKE 'P%'
               AND PROG IN ('dml017','dml063','dml067',
               'dml071','flg010','flg013') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For the NON-interactive SQL interfaces:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 <> 'SQL' AND PROG = 'mpquic' END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For Interactive SQL:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'SQL' AND 0 =
               (SELECT ISQL_CT FROM TESTCASE
               WHERE TESTCASE.TESTNO = T_REQ.TESTNO) END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For C, MUMPS, PLI - varchar host language declaration:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 <> 'PC' AND BINDING1 <> 'MC'
               AND PROG IN
               ('dml092','dml093','dml129','dml146','dml155',
                'isi008','ist008') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For C only:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'MC'
               AND TESTNO IN ('0183','0192','0193','0398','0399')
             END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For COBOL only:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'PCO' AND TESTNO = '0288' END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'MCO'
               AND TESTNO IN ('0185','0206','0207') END-EXEC
             MOVE SQLCODE TO SQL-COD
      * For COBOL only - OPTIONAL due to floating point data type:
             EXEC SQL UPDATE T_REQ
               SET REQOPTNA = 'OPT'
               WHERE (BINDING1 = 'MCO' OR BINDING1 = 'PCO')
               AND TESTNO = '0157' END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For FORTRAN only:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'MFO'
               AND TESTNO IN ('0217','0223','0392') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For PASCAL only:
             MOVE SQLCODE TO SQL-COD
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'MPA'
               AND TESTNO IN ('0238','0239') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For Ada only:
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'PAD'
               AND TESTNO IN ('0445','0456') END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
               WHERE BINDING1 = 'MAD'
               AND TESTNO IN ('0424','0445') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * Placeholder for deleted tests (permanently removed):
      * TEd maintenance changes will provide any appropriate test numb
             EXEC SQL UPDATE T_REQ
               SET REQOPTNA = 'DL' WHERE REQOPTNA <> 'NA'
                 AND TESTNO IN ('DL#1','DL#2') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * Placeholder for tests under review (to be run, but not judged
      * TEd maintenance changes will provide any appropriate test numb
             EXEC SQL UPDATE T_REQ
               SET REQOPTNA = 'UR' WHERE REQOPTNA <> 'NA'
                 AND TESTNO IN ('UR#1','UR#2') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * Placeholder for withdrawn tests (removed until Version 6.0):
      * TEd maintenance changes will provide any appropriate test numb
             EXEC SQL UPDATE T_REQ
               SET REQOPTNA = 'WD' WHERE REQOPTNA <> 'NA'
                 AND TESTNO IN ('WD#1','WD#2') END-EXEC
             MOVE SQLCODE TO SQL-COD

      * For the few MUMPS programs:
      *  EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
      *    WHERE (BINDING1 = 'PMU' OR BINDING1 = 'MMU')
      *      AND PROG NOT LIKE 'mum%'
      *      AND PROG NOT IN ('XXXXXX','YYYYYY');

      * For the few PL/I programs:
      *  EXEC SQL UPDATE T_REQ SET REQOPTNA = 'NA'
      *    WHERE (BINDING1 = 'PPL' OR BINDING1 = 'MPL')
      *      AND PROG NOT LIKE 'pli%'
      *      AND PROG NOT IN ('AAAAAA','BBBBBB');

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (debug1  =  1) then
               DISPLAY "After setting value of column REQOPTNA"
               PERFORM PTREQ THRU P240
             END-IF

      *=========================================================

      *=========================================================
      *Print programs to be EXECuted for each binding.
      *This is equivalent to RUNPC.BAS, RUNSQL.BAS, etc.
      *=========================================================

             DISPLAY  " "
             DISPLAY "REPORTA step 6: List programs for each binding."

             EXEC SQL DECLARE RUNALL_BAS CURSOR FOR
               SELECT DISTINCT BINDING1, AUTHID, TESTPROG.PROG, P_NOTE
               FROM T_REQ, TESTPROG
               WHERE T_REQ.PROG = TESTPROG.PROG
               AND REQOPTNA IN ('OPT','REQ','UR')
               ORDER BY 1, 2, 3 END-EXEC

             EXEC SQL OPEN RUNALL_BAS END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               DISPLAY "Problem #13 OPEN RUNALL_BAS, SQLCODE = ",
             SQL-COD
             END-IF
             MOVE 0 TO SQLCODE
             MOVE " " TO bind0
             DISPLAY " "
             DISPLAY "Run the following programs to test the interfaces
      -    " specified:"
           .
        P310.
             if (SQLCODE  =  100) then
               GO TO P311
             END-IF
             EXEC SQL FETCH RUNALL_BAS INTO :bind1, :uidx, :prog,
             :tpnote :indic1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (indic1  <  0) then
               MOVE " " TO tpnote
             END-IF
             if (bind0  NOT  =   bind1) then
               MOVE bind1 TO bind0
               DISPLAY  " "
               DISPLAY "PROGRAMS TO EXECUTE FOR INTERFACE ", bind1
             END-IF

      *language-independent lower casing for value of bind1
             if (bind1   =   "PC ") then
               MOVE "pc " TO bindlc
             END-IF
             if (bind1   =   "PCO") then
               MOVE "pco" TO bindlc
             END-IF
             if (bind1   =   "PFO") then
               MOVE "pfo" TO bindlc
             END-IF
             if (bind1   =   "PPA") then
               MOVE "ppa" TO bindlc
             END-IF
             if (bind1   =   "PAD") then
               MOVE "pad" TO bindlc
             END-IF
             if (bind1   =   "MC ") then
               MOVE "mc " TO bindlc
             END-IF
             if (bind1   =   "MCO") then
               MOVE "mco" TO bindlc
             END-IF
             if (bind1   =   "MFO") then
               MOVE "mfo" TO bindlc
             END-IF
             if (bind1   =   "MPA") then
               MOVE "mpa" TO bindlc
             END-IF
             if (bind1   =   "MAD") then
               MOVE "mad" TO bindlc
             END-IF
             if (bind1   =   "SQL") then
               MOVE "sql" TO bindlc
             END-IF

             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               DISPLAY "RUN", bind1, " ", prog, ".", bindlc, " AS
      -    " ", uidx, " ", tpnote
             END-IF
             GO TO P310
           .
        P311.
             DISPLAY  " "
             EXEC SQL CLOSE RUNALL_BAS END-EXEC
             MOVE SQLCODE TO SQL-COD
      *=========================================================

      *=========================================================
      *Print tests to delete from required programs.
      *Testing individual features (outside of profiles) is
      * tricky, because the programs were not structured for this.
      *TEd format may be input to TEd after cut and paste.
      *=========================================================

             EXEC SQL DECLARE DELETE_TESTNO CURSOR FOR
               SELECT DISTINCT TESTCASE.TESTNO, TESTCASE.PROG
               FROM TESTCASE, TESTPROG
               WHERE TESTCASE.PROG = TESTPROG.PROG
               AND TESTCASE.PROG IN
               (SELECT PROG FROM T_REQ)
               AND TESTCASE.TESTNO NOT IN
               (SELECT TESTNO FROM T_REQ)
               ORDER BY TESTNO END-EXEC
             EXEC SQL OPEN DELETE_TESTNO END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               DISPLAY "Problem #14 OPEN DELETE_TESTNO, SQLCODE = ",
             SQL-COD
             END-IF
             MOVE 0 TO iii
           .
        P410.
             EXEC SQL FETCH DELETE_TESTNO INTO :testno, :prog END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  100) then
               GO TO P411
             END-IF

             if (iii  =  0) then
               DISPLAY "DELETE the following tests from these programs:"
             END-IF
             COMPUTE iii = iii + 1
           DISPLAY "del ", prog, ".* /BEGIN TEST", testno,
                   "/END TEST", testno, "/"
             GO TO P410
           .
        P411.

             EXEC SQL CLOSE DELETE_TESTNO END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      *=========================================================

      *Did we get any suicide notes?
             if (errcnt  >  0) then
               MOVE 0 TO iii
               PERFORM P50 UNTIL iii > 9
             END-IF

             DISPLAY  " "

      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

      *    ****  Procedures for PERFORM statements

      *The following routines list entire table contents for debugging

        PFREQ.
             EXEC SQL DECLARE F_REQ_CURSOR CURSOR FOR
               SELECT * FROM F_REQ ORDER BY C1, P1, F1 END-EXEC
             EXEC SQL OPEN F_REQ_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY  " "
             DISPLAY "F_REQ Listing"
             MOVE 0 TO SQLCODE
             MOVE 0 TO iii
           .
        P210.
             EXEC SQL FETCH F_REQ_CURSOR INTO :feat1, :feat2, :feat3,
             :lvl END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               COMPUTE iii = iii + 1
               DISPLAY "C1=", feat1, ", P1=", feat2, ", F1=", feat3, ",
      -    " LVL=", lvl
               GO TO P210
             END-IF
             EXEC SQL CLOSE F_REQ_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY iii, " rows selected"
             DISPLAY  " ".

        PFTEMP.
             EXEC SQL DECLARE F_TEMP_CURSOR CURSOR FOR
               SELECT * FROM F_TEMP ORDER BY C1, P1, F1 END-EXEC
             EXEC SQL OPEN F_TEMP_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY  " "
             DISPLAY "F_TEMP Listing"
             MOVE 0 TO SQLCODE
             MOVE 0 TO iii
           .
        P220.
             EXEC SQL FETCH F_TEMP_CURSOR INTO :feat1, :feat2, :feat3,
             :lvl END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               COMPUTE iii = iii + 1
               DISPLAY "C1=", feat1, ", P1=", feat2, ", F1=", feat3, ",
      -    " LVL=", lvl
               GO TO P220
             END-IF
             EXEC SQL CLOSE F_TEMP_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY iii, " rows selected"
             DISPLAY  " ".

        PRSTR.
             EXEC SQL DECLARE R_STRUCTURE_CURSOR CURSOR FOR
               SELECT * FROM R_STRUCTURE ORDER BY C1, P1, TESTNO
             END-EXEC
             EXEC SQL OPEN R_STRUCTURE_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY  " "
             DISPLAY "R_STRUCTURE Listing"
             MOVE 0 TO SQLCODE
             MOVE 0 TO iii
           .
        P230.
             EXEC SQL FETCH R_STRUCTURE_CURSOR INTO :feat1, :feat2,
             :feat3, :lvl END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               COMPUTE iii = iii + 1
               DISPLAY "C1=", feat1, ", P1=", feat2, ", TESTNO=", feat3,
             ", LVL=", lvl
               GO TO P230
             END-IF
             EXEC SQL CLOSE R_STRUCTURE_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY iii, " rows selected"
             DISPLAY  " ".

        PTREQ.
             EXEC SQL DECLARE T_REQ_CURSOR CURSOR FOR
               SELECT * FROM T_REQ ORDER BY BINDING1, PROG, TESTNO
             END-EXEC
             EXEC SQL OPEN T_REQ_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY  " "
             DISPLAY "T_REQ Listing"
             MOVE 0 TO SQLCODE
             MOVE 0 TO iii
           .
        P240.
             EXEC SQL FETCH T_REQ_CURSOR INTO :testno, :prog, :bind1,
             :reqopt, :result END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               COMPUTE iii = iii + 1
               DISPLAY "TESTNO=", testno, ",PROG=", prog, " ", bind1, "
               " ", reqopt, " ", result
               GO TO P240
             END-IF
             EXEC SQL CLOSE T_REQ_CURSOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY iii, " rows selected"
             DISPLAY  " ".

        P50.
                 DISPLAY " ***************************************"
                 DISPLAY " **** Do not run the REPORT program. ***"
                 DISPLAY " **** Correct ", errcnt, " errors and rerun!
      -    " ****"
                 DISPLAY " ***************************************"
               ADD 1 TO iii
           .

¤ Dauer der Verarbeitung: 0.47 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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 ist noch experimentell.