diff --git a/deploy/installers/linux/gixsql-test/TSQL006B.cbl b/deploy/installers/linux/gixsql-test/TSQL006B.cbl new file mode 100644 index 00000000..10505361 --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL006B.cbl @@ -0,0 +1,81 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL006B. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + + 01 S-SQLCOMMAND. + 03 S-SQLCOMMAND-LEN PIC S9(8) COMP-5. + 03 S-SQLCOMMAND-ARR PIC X(250). + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + + DISPLAY '***************************************'. + DISPLAY " DATASRC : " DATASRC. + DISPLAY " AUTH : " DBUSR. + DISPLAY '***************************************'. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'CONNECT SQLCODE. ' SQLCODE + DISPLAY 'CONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + + MOVE EXEC-SQLCOMMAND TO S-SQLCOMMAND-ARR. + MOVE FUNCTION LENGTH(FUNCTION TRIM(S-SQLCOMMAND-ARR)) + TO S-SQLCOMMAND-LEN. + + EXEC SQL AT :DBS + PREPARE P1 FROM :S-SQLCOMMAND + END-EXEC. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL + CONNECT RESET + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'DISCONNECT SQLCODE. ' SQLCODE + DISPLAY 'DISCONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-EXIT. + STOP RUN. diff --git a/deploy/installers/linux/gixsql-test/TSQL006C.cbl b/deploy/installers/linux/gixsql-test/TSQL006C.cbl new file mode 100644 index 00000000..cd255b98 --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL006C.cbl @@ -0,0 +1,98 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL006C. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + + 01 EXEC-SQLCOMMAND PIC X(100) VALUE 'SELECT 1'. + + 01 S-SQLCOMMAND. + 49 S-SQLCOMMAND-LEN PIC S9(8) COMP-5. + 49 S-SQLCOMMAND-ARR PIC X(250). + + 01 S-SQLCOMMAND-2 PIC X(250). + + 01 S-SQLCOMMAND-3. + 03 S-SQLCOMMAND-3-LEN PIC S9(8) COMP-5. + 03 S-SQLCOMMAND-3-ARR PIC X(250). + + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY '***************************************'. + DISPLAY " DATASRC : " DATASRC. + DISPLAY " AUTH : " DBUSR. + DISPLAY '***************************************'. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'CONNECT SQLCODE. ' SQLCODE + DISPLAY 'CONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + + MOVE EXEC-SQLCOMMAND TO S-SQLCOMMAND-ARR. + MOVE FUNCTION LENGTH(FUNCTION TRIM(S-SQLCOMMAND-ARR)) + TO S-SQLCOMMAND-LEN. + + EXEC SQL + PREPARE P1 FROM :S-SQLCOMMAND + END-EXEC. + + EXEC SQL + PREPARE P2 FROM :S-SQLCOMMAND-2 + END-EXEC. + + EXEC SQL + PREPARE P2 FROM :S-SQLCOMMAND-3-ARR + END-EXEC. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL + CONNECT RESET + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'DISCONNECT SQLCODE. ' SQLCODE + DISPLAY 'DISCONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-EXIT. + STOP RUN. diff --git a/deploy/installers/linux/gixsql-test/TSQL007A.cbl b/deploy/installers/linux/gixsql-test/TSQL007A.cbl index 22bfae4f..568b0605 100644 --- a/deploy/installers/linux/gixsql-test/TSQL007A.cbl +++ b/deploy/installers/linux/gixsql-test/TSQL007A.cbl @@ -440,8 +440,17 @@ 041600 COMP-FOOT-EXIT. 041700 EXIT. 041800 + +035800 DO-FILE SECTION. + +035800*DO-WORKING-STORAGE SECTION. + +035800 DO-LINKAGE SECTION. + 041900 END DECLARATIVES. 042000 + + 042100 000-INITIATE. 042200 042300 OPEN INPUT PAYROLL-REGISTER-DATA, diff --git a/deploy/installers/linux/gixsql-test/TSQL012A.cbl b/deploy/installers/linux/gixsql-test/TSQL012A.cbl index 4cf68bcd..2d22e36c 100644 --- a/deploy/installers/linux/gixsql-test/TSQL012A.cbl +++ b/deploy/installers/linux/gixsql-test/TSQL012A.cbl @@ -29,6 +29,10 @@ 01 T1 PIC 9(3) VALUE 0. 01 TABROWID PIC 9(8) VALUE 0. + 01 DESCRIPTOR PIC 9(8) VALUE 0. + 01 OID PIC 9(8) VALUE 0. + 01 LEN PIC 9(8) VALUE 0. + 01 RES PIC 9(8) VALUE 0. EXEC SQL INCLUDE SQLCA @@ -70,6 +74,16 @@ REFNR = :T1) END-EXEC. + * EXEC SQL + * SELECT LEN INTO :LEN FROM TAB WHERE OID=:OID + * END-EXEC. + * + * EXEC SQL + * SELECT lo_close (:DESCRIPTOR) INTO :RES + * FROM TAB + * WHERE OID=:OID + * END-EXEC. + DISPLAY 'SELECT SQLCODE: ' SQLCODE. IF SQLCODE <> 0 THEN diff --git a/deploy/installers/linux/gixsql-test/TSQL015A.cbl b/deploy/installers/linux/gixsql-test/TSQL015A.cbl index f5b7b19a..d93c5e0b 100644 --- a/deploy/installers/linux/gixsql-test/TSQL015A.cbl +++ b/deploy/installers/linux/gixsql-test/TSQL015A.cbl @@ -18,15 +18,15 @@ WORKING-STORAGE SECTION. - EXEC SQL - INCLUDE EMPREC - END-EXEC. - 01 DATASRC PIC X(64). 01 DBS PIC X(64). 01 DBUSR PIC X(64). 01 DBPWD PIC X(64). + + 01 Z-MY-ELEMENTS PIC 9(8). + 78 MY-CONSTANT VALUE 16. + EXEC SQL INCLUDE SQLCA END-EXEC. @@ -39,7 +39,22 @@ 05 FILLER OCCURS UNBOUNDED DEPENDING ON L-DYNBUFFER-LEN PIC X. + + 01 L-DYNBUFFER. + 05 FILLER OCCURS 0 TO MY-CONSTANT TIMES + DEPENDING ON L-DYNBUFFER-LEN + PIC X. + 01 MY-TAB. + 05 MY-NO PIC 9(009) COMP-5 VALUE ZERO. + 05 MY-TAB-CACHE OCCURS 100 + DEPENDING ON Z-MY-ELEMENTS + ASCENDING KEY IS MY-ID + INDEXED BY I-TAB. + 07 MY-ELEMENT. + 10 MY-ID PIC 9(009) COMP-5 VALUE ZERO. + 10 MY-DATA PIC X(02189) VALUE SPACE. + PROCEDURE DIVISION. 000-CONNECT. diff --git a/deploy/installers/linux/gixsql-test/TSQL018A.cbl b/deploy/installers/linux/gixsql-test/TSQL018A.cbl new file mode 100644 index 00000000..17622dfe --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL018A.cbl @@ -0,0 +1,126 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL018A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + + 01 DATA-01 PIC X(64). + 01 DATA-02 PIC X(64). + 01 DATA-03 PIC X(64). + 01 DATA-04 PIC X(64). + 01 DATA-05 PIC X(64). + 01 DATA-06 PIC X(64). + 01 DATA-07 PIC X(64). + 01 DATA-08 PIC X(64). + 01 DATA-09 PIC X(64). + 01 DATA-10 PIC X(64). + 01 DATA-11 PIC X(64). + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL + SELECT + GENEX.CASE_BARCODE AS CASE_BARCODE, + GENEX.SAMPLE_BARCODE AS SAMPLE_BARCODE, + GENEX.ALIQUOT_BARCODE AS ALIQUOT_BARCODE, + GENEX.HGNC_GENE_SYMBOL AS HGNC_GENE_SYMBOL, + CLINICAL_INFO.VARIANT_TYPE AS VARIANT_TYPE, + GENEX.GENE_ID AS GENE_ID, + GENEX.NORMALIZED_COUNT AS NORMALIZED_COUNT, + GENEX.PROJECT_SHORT_NAME AS PROJECT_SHORT_NAME, + CLINICAL_INFO.DEMO__GENDER AS GENDER, + CLINICAL_INFO.DEMO__VITAL_STATUS AS VITAL_STATUS, + CLINICAL_INFO.DEMO__DAYS_TO_DEATH AS DAYS_TO_DEATH + INTO + :DATA-01, :DATA-02, :DATA-03, :DATA-04, + :DATA-05, :DATA-06, :DATA-07, :DATA-08, + :DATA-09, :DATA-10, :DATA-11 + FROM ( + SELECT + CASE_LIST.VARIANT_TYPE AS VARIANT_TYPE, + CASE_LIST.CASE_BARCODE AS CASE_BARCODE, + CLINICAL.DEMO__GENDER, + CLINICAL.DEMO__VITAL_STATUS, + CLINICAL.DEMO__DAYS_TO_DEATH + FROM + (SELECT + MUTATION.CASE_BARCODE, + MUTATION.VARIANT_TYPE + FROM + ISB-CGC-BQ.TCGA_VERSIONED.SM_HG19_DCC_02 AS MUTATION + WHERE + MUTATION.HUGO_SYMBOL = 'CDKN2A' + AND PROJECT_SHORT_NAME = 'TCGA-BLCA' + GROUP BY + MUTATION.CASE_BARCODE, + MUTATION.VARIANT_TYPE + ORDER BY + MUTATION.CASE_BARCODE + ) AS CASE_LIST + INNER JOIN + ISB-CGC-BQ.TCGA.CLINICAL_GDC_CURRENT AS CLINICAL + ON + CASE_LIST.CASE_BARCODE = CLINICAL.SUBMITTER_ID ) + AS CLINICAL_INFO + INNER JOIN + ISB-CGC-BQ.TCGA_VERSIONED.RNASEQ_HG19_GDC_2017_02 + AS GENEX + ON + GENEX.CASE_BARCODE = CLINICAL_INFO.CASE_BARCODE + WHERE + GENEX.HGNC_GENE_SYMBOL IN + ('MDM2', 'TP53', 'CDKN1A','CCNE1') + ORDER BY + CASE_BARCODE, + HGNC_GENE_SYMBOL + END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + 100-EXIT. + STOP RUN. + + 200-END. diff --git a/deploy/installers/linux/gixsql-test/TSQL019A.cbl b/deploy/installers/linux/gixsql-test/TSQL019A.cbl new file mode 100644 index 00000000..266b12c5 --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL019A.cbl @@ -0,0 +1,207 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL019A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + + 01 REC-ID PIC 9(4). + + 01 TORNW-1 PIC S9(018)V9(12) COMP-3. + 01 TORNW-2 PIC S9(018) COMP-3. + 01 TORNW-3 PIC 9(018) COMP-3. + 01 TORNW-4 PIC 9(018)V9(12) COMP-3. + + 01 TORNR-1 PIC S9(018)V9(12) COMP-3. + 01 TORNR-2 PIC S9(018) COMP-3. + 01 TORNR-3 PIC 9(018) COMP-3. + 01 TORNR-4 PIC 9(018)V9(12) COMP-3. + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + DISPLAY 'START TRANSACTION SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + + * EXEC SQL TRUNCATE TABLE TAB_A END-EXEC. + + MOVE 1 TO REC-ID. + MOVE -42.74 TO TORNW-1. + + * PIC S9(018)V9(12) COMP-3. + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-1) + END-EXEC. + DISPLAY 'INSERT 1 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 1 DATA : ' TORNW-1. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 2 TO REC-ID. + MOVE -112 TO TORNW-2. + + * PIC S9(018) COMP-3. + + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-2) + END-EXEC. + DISPLAY 'INSERT 2 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 2 DATA : ' TORNW-2. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 3 TO REC-ID. + MOVE 237 TO TORNW-3. + + * PIC 9(018) COMP-3. + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-3) + END-EXEC. + DISPLAY 'INSERT 3 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 3 DATA : ' TORNW-3. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 4 TO REC-ID. + MOVE 127.22 TO TORNW-4. + + * PIC 9(018)V9(12) COMP-3. + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-4) + END-EXEC. + DISPLAY 'INSERT 4 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 4 DATA : ' TORNW-4. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * read tests + + EXEC SQL + SELECT TORNW INTO :TORNR-1 FROM TAB_A + WHERE ID = 1 + END-EXEC. + DISPLAY 'SELECT 1 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 1 DATA : ' TORNR-1. + + EXEC SQL + SELECT TORNW INTO :TORNR-2 FROM TAB_A + WHERE ID = 2 + END-EXEC. + DISPLAY 'SELECT 2 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 2 DATA : ' TORNR-2. + + EXEC SQL + SELECT TORNW INTO :TORNR-3 FROM TAB_A + WHERE ID = 3 + END-EXEC. + DISPLAY 'SELECT 3 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 3 DATA : ' TORNR-3. + + EXEC SQL + SELECT TORNW INTO :TORNR-4 FROM TAB_A + WHERE ID = 4 + END-EXEC. + DISPLAY 'SELECT 4 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 4 DATA : ' TORNR-4. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + IF TORNW-1 = TORNR-1 THEN + DISPLAY 'RES 1 : OK' + ELSE + DISPLAY 'RES 1 : KO' + END-IF. + + IF TORNW-2 = TORNR-2 THEN + DISPLAY 'RES 2 : OK' + ELSE + DISPLAY 'RES 2 : KO' + END-IF. + + IF TORNW-3 = TORNR-3 THEN + DISPLAY 'RES 3 : OK' + ELSE + DISPLAY 'RES 3 : KO' + END-IF. + + IF TORNW-4 = TORNR-4 THEN + DISPLAY 'RES 4 : OK' + ELSE + DISPLAY 'RES 4 : KO' + END-IF. + 100-EXIT. + + IF SQLCODE <> 0 THEN + DISPLAY 'SQLERRM ' SQLERRM + END-IF. + + STOP RUN. + + 200-END. diff --git a/deploy/installers/linux/gixsql-test/TSQL019B.cbl b/deploy/installers/linux/gixsql-test/TSQL019B.cbl new file mode 100644 index 00000000..817192a6 --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL019B.cbl @@ -0,0 +1,208 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL019B. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + + 01 REC-ID PIC 9(4). + + 01 TORNW-1 PIC S9(018)V9(12) . + 01 TORNW-2 PIC S9(018) . + 01 TORNW-3 PIC 9(018) . + 01 TORNW-4 PIC 9(018)V9(12) . + + 01 TORNR-1 PIC S9(018)V9(12) . + 01 TORNR-2 PIC S9(018) . + 01 TORNR-3 PIC 9(018) . + 01 TORNR-4 PIC 9(018)V9(12) . + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + DISPLAY 'START TRANSACTION SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + + EXEC SQL TRUNCATE TABLE TAB_A END-EXEC. + + MOVE 1 TO REC-ID. + MOVE -42.74 TO TORNW-1. + + * PIC S9(018)V9(12) . + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-1) + END-EXEC. + DISPLAY 'INSERT 1 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 1 DATA : ' TORNW-1. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 2 TO REC-ID. + MOVE -112 TO TORNW-2. + + * PIC S9(018) . + + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-2) + END-EXEC. + DISPLAY 'INSERT 2 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 2 DATA : ' TORNW-2. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 3 TO REC-ID. + MOVE 237 TO TORNW-3. + + * PIC 9(018) . + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-3) + END-EXEC. + DISPLAY 'INSERT 3 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 3 DATA : ' TORNW-3. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 4 TO REC-ID. + MOVE 127.22 TO TORNW-4. + + * PIC 9(018)V9(12) . + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-4) + END-EXEC. + DISPLAY 'INSERT 4 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 4 DATA : ' TORNW-4. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * read tests + + EXEC SQL + SELECT TORNW INTO :TORNR-1 FROM TAB_A + WHERE ID = 1 + END-EXEC. + DISPLAY 'SELECT 1 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 1 DATA : ' TORNR-1. + + EXEC SQL + SELECT TORNW INTO :TORNR-2 FROM TAB_A + WHERE ID = 2 + END-EXEC. + DISPLAY 'SELECT 2 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 2 DATA : ' TORNR-2. + + EXEC SQL + SELECT TORNW INTO :TORNR-3 FROM TAB_A + WHERE ID = 3 + END-EXEC. + DISPLAY 'SELECT 3 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 3 DATA : ' TORNR-3. + + EXEC SQL + SELECT TORNW INTO :TORNR-4 FROM TAB_A + WHERE ID = 4 + END-EXEC. + DISPLAY 'SELECT 4 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 4 DATA : ' TORNR-4. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + IF TORNW-1 = TORNR-1 THEN + DISPLAY 'RES 1 : OK' + ELSE + DISPLAY 'RES 1 : KO' + END-IF. + + IF TORNW-2 = TORNR-2 THEN + DISPLAY 'RES 2 : OK' + ELSE + DISPLAY 'RES 2 : KO' + END-IF. + + IF TORNW-3 = TORNR-3 THEN + DISPLAY 'RES 3 : OK' + ELSE + DISPLAY 'RES 3 : KO' + END-IF. + + IF TORNW-4 = TORNR-4 THEN + DISPLAY 'RES 4 : OK' + ELSE + DISPLAY 'RES 4 : KO' + END-IF. + + 100-EXIT. + + IF SQLCODE <> 0 THEN + DISPLAY 'SQLERRM ' SQLERRM + END-IF. + + STOP RUN. + + 200-END. diff --git a/deploy/installers/linux/gixsql-test/TSQL020A.cbl b/deploy/installers/linux/gixsql-test/TSQL020A.cbl new file mode 100644 index 00000000..2f7a6389 --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL020A.cbl @@ -0,0 +1,76 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL020A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + EXEC SQL + INCLUDE EMPREC + END-EXEC. + + 01 DATASRC PIC X(64). + 01 DBS PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + 01 BLOB1 PIC X(64). + + 01 LEN PIC 9(8) COMP-3. + 01 OFFSET PIC 9(8) COMP-3. + 01 REC1 PIC X(1000000). + + 01 VAR1 PIC 9(3) VALUE 0. + 01 VAR2 PIC 9(3) VALUE 0. + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE + + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL AT :DBS + SELECT VAR1::numeric + INTO :VAR1 + FROM TAB + WHERE :VAR2::numeric = 10 + END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + 100-EXIT. + STOP RUN. + + 200-END. diff --git a/deploy/installers/linux/gixsql-test/TSQL021A.cbl b/deploy/installers/linux/gixsql-test/TSQL021A.cbl new file mode 100644 index 00000000..769bd54e --- /dev/null +++ b/deploy/installers/linux/gixsql-test/TSQL021A.cbl @@ -0,0 +1,198 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL021A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + EXEC SQL + INCLUDE EMPREC + END-EXEC. + + 01 DATASRC PIC X(64). + 01 DATASRC-FULL PIC X(64). + 01 DBS PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + 01 DBUSRPWD PIC X(128). + 01 DBNAME PIC X(64). + + 01 T1 PIC 9(4). + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC_FULL" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC-FULL FROM ENVIRONMENT-VALUE. + + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + + DISPLAY "DBUSR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + + DISPLAY "DBPWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + DISPLAY "DBNAME" UPON ENVIRONMENT-NAME. + ACCEPT DBNAME FROM ENVIRONMENT-VALUE. + + DISPLAY "DBUSRPWD" UPON ENVIRONMENT-NAME. + ACCEPT DBUSRPWD FROM ENVIRONMENT-VALUE. + + 100-MAIN. + + MOVE 'CONN1' TO DBS + + * mode 1 (anonymous) + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + DISPLAY 'CONNECT 1A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET END-EXEC. + + * mode 2 (anonymous) + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSRPWD + END-EXEC. + DISPLAY 'CONNECT 2A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET END-EXEC. + + * mode 3 (anonymous) + + EXEC SQL + CONNECT :DBUSR + IDENTIFIED BY :DBPWD + USING :DATASRC + END-EXEC. + DISPLAY 'CONNECT 3A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET END-EXEC. + + * mode 4 (anonymous) - Unsupported - emit a preproc warning + + EXEC SQL + CONNECT :DBUSR IDENTIFIED BY :DBPWD + END-EXEC. + DISPLAY 'CONNECT 4A SQLCODE: ' SQLCODE. + + * we ignore the error for mode 4 + * IF SQLCODE <> 0 THEN + * GO TO 100-EXIT + * END-IF. + + * mode 5 (anonymous) + + EXEC SQL + CONNECT USING :DATASRC-FULL + END-EXEC. + DISPLAY 'CONNECT 5A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * mode 6 (anonymous) + + EXEC SQL + CONNECT TO :DBNAME + USER :DBUSR + USING :DATASRC + IDENTIFIED BY :DBPWD + END-EXEC. + DISPLAY 'CONNECT 6A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * mode 1 (named) + + EXEC SQL + CONNECT TO :DATASRC AS :DBS USER :DBUSR USING :DBPWD + END-EXEC. + DISPLAY 'CONNECT 1N SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET :DBS END-EXEC. + + * mode 2 (named) + + EXEC SQL + CONNECT TO :DATASRC AS :DBS USER :DBUSRPWD + END-EXEC. + DISPLAY 'CONNECT 2N SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET :DBS END-EXEC. + + * mode 3 (named) + + EXEC SQL + CONNECT :DBUSR + IDENTIFIED BY :DBPWD + AT :DBS + USING :DATASRC + END-EXEC. + DISPLAY 'CONNECT 3N SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET :DBS END-EXEC. + + * mode 4 (named) - Unsupported - emit a preproc warning + + EXEC SQL + CONNECT :DBUSR IDENTIFIED BY :DBPWD + AT :DBS + END-EXEC. + DISPLAY 'CONNECT 4N SQLCODE: ' SQLCODE. + + * we ignore the error for mode 4 + * IF SQLCODE <> 0 THEN + * GO TO 100-EXIT + * END-IF. + + * last step, we need to "force" the error code, otherwise the test will fail + + MOVE 0 TO RETURN-CODE. + + * mode 5 and 6 do not support named connections + + 100-EXIT. + STOP RUN. + + 200-END. diff --git a/gixpp/main.cpp b/gixpp/main.cpp index 88a48fe1..2b61bdc4 100644 --- a/gixpp/main.cpp +++ b/gixpp/main.cpp @@ -37,7 +37,7 @@ USA. #define PATH_LIST_SEP ":" #endif -#define GIXPP_VER "1.0.11a" +#define GIXPP_VER "1.0.11b" using namespace popl; @@ -75,6 +75,7 @@ int main(int argc, char **argv) auto opt_verbose = options.add("v", "verbose", "verbose"); auto opt_verbose_debug = options.add("d", "verbose-debug", "verbose (debug)"); auto opt_emit_map_file = options.add("m", "map", "emit map file"); + auto opt_emit_cobol85 = options.add("C", "cobol85", "emit COBOL85-compliant code"); options.parse(argc, argv); @@ -123,6 +124,7 @@ int main(int argc, char **argv) gp.setOpt("preprocess_copy_files", opt_esql_preprocess_copy->is_set()); gp.setOpt("consolidated_map", true); gp.setOpt("emit_map_file", opt_emit_map_file->is_set()); + gp.setOpt("emit_cobol85", opt_emit_cobol85->is_set()); gp.addStep(new TPESQLProcessing(&gp)); if (opt_esql_copy_exts->is_set()) copy_resolver.setExtensions(string_split(opt_esql_copy_exts->value(), ",")); diff --git a/gixsql-tests/GixSqlTestBase.cs b/gixsql-tests/GixSqlTestBase.cs index feadad79..8ef4373e 100644 --- a/gixsql-tests/GixSqlTestBase.cs +++ b/gixsql-tests/GixSqlTestBase.cs @@ -283,7 +283,9 @@ public void End() Directory.Delete(TestTempDir, true); } - protected void compile(CompilerType ctype, string configuration, string platform, string build_type) + protected void compile(CompilerType ctype, string configuration, string platform, string build_type, + bool expected_to_fail_pp = false, bool expected_to_fail_cobc = false, + string additional_pp_params = "", string additional_cobc_params = "") { string cwd = "."; string compiler_init_cmd = "break"; // break does nothing @@ -301,13 +303,16 @@ protected void compile(CompilerType ctype, string configuration, string platform CompilerConfig cc = CompilerConfig.init(ctype, configuration, platform, build_type); // Preprocess - string args = $"-e -v -S -I. -I{cc.gix_copy_path} -i {msrc} -o {pp_file}"; - Console.WriteLine($"[gixpp]: {cc.gixpp_exe} {args}"); + string gixpp_args = $"-e -v -S -I. -I{cc.gix_copy_path} -i {msrc} -o {pp_file}"; + if (additional_pp_params != "") + gixpp_args += (" " + additional_pp_params); + + Console.WriteLine($"[gixpp]: {cc.gixpp_exe} {gixpp_args}"); var r1 = Task.Run(async () => { return await Cli.Wrap(cc.gixpp_exe) - .WithArguments(args) + .WithArguments(gixpp_args) //.WithStandardOutputPipe(PipeTarget.ToStringBuilder(stdOutBuffer, System.Text.Encoding.ASCII)) //.WithStandardErrorPipe(PipeTarget.ToStringBuilder(stdErrBuffer, System.Text.Encoding.ASCII)) //.WithEnvironmentVariables(env) @@ -320,9 +325,17 @@ protected void compile(CompilerType ctype, string configuration, string platform Console.WriteLine(r1.Result.StandardError); Console.Out.Flush(); - Assert.IsTrue(r1.Result.ExitCode == 0, $"Exit code : {r1.Result.ExitCode:x}"); - Assert.IsTrue(File.Exists(pp_file)); - Assert.IsTrue((new FileInfo(pp_file)).Length > 0); + if (!expected_to_fail_pp) + { + Assert.IsTrue(r1.Result.ExitCode == 0, $"Exit code : {r1.Result.ExitCode:x}"); + Assert.IsTrue(File.Exists(pp_file)); + Assert.IsTrue((new FileInfo(pp_file)).Length > 0); + } + else { + Assert.IsFalse(r1.Result.ExitCode == 0, $"Exit code : {r1.Result.ExitCode:x}"); + Console.WriteLine("Preprocessing failed (it was expected)"); + return; + } // Compile @@ -340,8 +353,12 @@ protected void compile(CompilerType ctype, string configuration, string platform var r2 = Task.Run(async () => { + string cobc_args = $"/C \"{compiler_init_cmd} && {cc.cobc_exe} {opt_exe} -I. -I{cc.gix_copy_path} {pp_file} -l{cc.link_lib_lname} -L{cc.link_lib_dir_path}"; + if (additional_cobc_params != "") + cobc_args += (" " + additional_cobc_params); + return await Cli.Wrap("cmd.exe") - .WithArguments($"/C \"{compiler_init_cmd} && {cc.cobc_exe} {opt_exe} -I. -I{cc.gix_copy_path} {pp_file} -l{cc.link_lib_lname} -L{cc.link_lib_dir_path}") + .WithArguments(cobc_args) //.WithStandardOutputPipe(PipeTarget.ToStringBuilder(stdOutBuffer)) //.WithStandardErrorPipe(PipeTarget.ToStringBuilder(stdErrBuffer)) .WithEnvironmentVariables(new Dictionary @@ -356,12 +373,19 @@ protected void compile(CompilerType ctype, string configuration, string platform Console.WriteLine(r2.Result.StandardOutput); Console.WriteLine(r2.Result.StandardError); - Assert.IsTrue(r2.Result.ExitCode == 0, $"Exit code : {r2.Result.ExitCode}"); - Assert.IsTrue(File.Exists(outfile)); - FileInfo fi = new FileInfo(outfile); - Assert.IsTrue(fi.Length > 0); - - Console.WriteLine($"Output: {fi.FullName} ({fi.Length} bytes)"); + if (!expected_to_fail_cobc) + { + Assert.IsTrue(r2.Result.ExitCode == 0, $"Exit code : {r2.Result.ExitCode}"); + Assert.IsTrue(File.Exists(outfile)); + FileInfo fi = new FileInfo(outfile); + Assert.IsTrue(fi.Length > 0); + Console.WriteLine($"Output: {fi.FullName} ({fi.Length} bytes)"); + } + else + { + Assert.IsFalse(r2.Result.ExitCode == 0, $"Exit code : {r2.Result.ExitCode}"); + Console.WriteLine("COBOL compilation failed (it was expected)"); + } } finally { @@ -565,5 +589,10 @@ protected string get_datasource_pwd(int ds_index = 0) { return get_ds_val("pwd", ds_index); } + + protected string get_datasource_dbname(int ds_index = 0) + { + return get_ds_val("dbname", ds_index); + } } } diff --git a/gixsql-tests/TSQL006.cs b/gixsql-tests/TSQL006.cs index a8c90c9c..0e790f98 100644 --- a/gixsql-tests/TSQL006.cs +++ b/gixsql-tests/TSQL006.cs @@ -47,5 +47,26 @@ public void TSQL006A_MSVC_pgsql_x64_exe() }); } + [TestMethod] + [CobolSource("TSQL006B.cbl")] + [GixSqlDataSource("pgsql", 1)] + [Description("Traps invalid variable for prepared statements")] + public void TSQL006B_MSVC_pgsql_x64_exe() + { + compile(CompilerType.MSVC, "release", "x64", "exe", true); + + } + + [TestMethod] + [CobolSource("TSQL006C.cbl")] + [GixSqlDataSource("pgsql", 1)] + [Description("Traps invalid variable for prepared statements (correct format, should succeed)")] + public void TSQL006C_MSVC_pgsql_x64_exe() + { + compile(CompilerType.MSVC, "release", "x64", "exe", false, false); + + } + + } } diff --git a/gixsql-tests/TSQL015.cs b/gixsql-tests/TSQL015.cs index 3f3589c6..e9d11dee 100644 --- a/gixsql-tests/TSQL015.cs +++ b/gixsql-tests/TSQL015.cs @@ -22,7 +22,7 @@ public class TSQL015 : GixSqlTestBase [TestMethod] - [CobolSource("TSQL015A.cbl", "EMPREC.cpy")] + [CobolSource("TSQL015A.cbl")] [GixSqlDataSource("pgsql", 1)] public void TSQL015A_MSVC_pgsql_x64_exe() { diff --git a/gixsql-tests/TSQL018.cs b/gixsql-tests/TSQL018.cs new file mode 100644 index 00000000..d3e64ad0 --- /dev/null +++ b/gixsql-tests/TSQL018.cs @@ -0,0 +1,47 @@ +using gix_ide_tests; +using Microsoft.VisualStudio.TestTools.UnitTesting; +using System; +using System.Data.Common; +using System.IO; + +namespace gixsql_tests +{ + [TestClass] + [HostPlatform("x64")] + [TestCategory("Long queries break COBOL compiler (#89)")] + public class TSQL018 : GixSqlTestBase + { + [TestInitialize] + public new void Begin() + { + base.Begin(); + + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG_ON", "1"); + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG", Path.Combine(TestTempDir, "gisql-debug.log")); + Environment.SetEnvironmentVariable("GIXSQL_ERR_LOG", Path.Combine(TestTempDir, "gisql-error.log")); + } + + [TestMethod] + [CobolSource("TSQL018A.cbl")] + [GixSqlDataSource("pgsql", 1)] + public void TSQL018A_MSVC_pgsql_x64_exe_cobol85() + { + // "true" COBOL-85 is way too strict, we use "-std ibm" for testing + compile(CompilerType.MSVC, "release", "x64", "exe", false, false, "--cobol85", "-std ibm"); + + Console.WriteLine("Performed syntax check+compile only: OK"); + } + + [TestMethod] + [CobolSource("TSQL018A.cbl")] + [GixSqlDataSource("pgsql", 1)] + public void TSQL018A_MSVC_pgsql_x64_exe_cobol2002() + { + compile(CompilerType.MSVC, "release", "x64", "exe", false, false); + + Console.WriteLine("Performed syntax check+compile only: OK"); + } + + + } +} diff --git a/gixsql-tests/TSQL019.cs b/gixsql-tests/TSQL019.cs new file mode 100644 index 00000000..3915f4d8 --- /dev/null +++ b/gixsql-tests/TSQL019.cs @@ -0,0 +1,140 @@ +using gix_ide_tests; +using Microsoft.VisualStudio.TestTools.UnitTesting; +using System; +using System.Data.Common; +using System.IO; + +namespace gixsql_tests +{ + [TestClass] + [HostPlatform("x64")] + [TestCategory("Length/power issues with COMP-3 (#92)")] + public class TSQL019 : GixSqlTestBase + { + [TestInitialize] + public new void Begin() + { + base.Begin(); + + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG_ON", "1"); + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG", Path.Combine(TestTempDir, "gisql-debug.log")); + Environment.SetEnvironmentVariable("GIXSQL_ERR_LOG", Path.Combine(TestTempDir, "gisql-error.log")); + } + + + [TestMethod] + [CobolSource("TSQL019A.cbl")] + [GixSqlDataSource("pgsql", 1)] + public void TSQL019A_MSVC_pgsql_x64_exe() + { + compile(CompilerType.MSVC, "release", "x64", "exe"); + + using (var conn = GetConnection()) + { + try + { + conn.Open(); + using (var cmd = conn.CreateCommand()) + { + cmd.CommandText = "drop table if exists tab_a"; + cmd.ExecuteNonQuery(); + + cmd.CommandText = "create table tab_a (id int, tornw numeric(30,12))"; + cmd.ExecuteNonQuery(); + } + } + finally + { + if (conn != null && conn.State == System.Data.ConnectionState.Open) + conn.Close(); + } + + } + + Environment.SetEnvironmentVariable("DATASRC", build_data_source_string(false, true, true)); + Environment.SetEnvironmentVariable("DATASRC_USR", get_datasource_usr()); + Environment.SetEnvironmentVariable("DATASRC_PWD", get_datasource_pwd()); + + run(CompilerType.MSVC, "release", "x64", "exe", "", false, new string[] { + "INSERT 1 SQLCODE: +0000000000", + "INSERT 1 DATA : -000000000000000042.740000000000", + "INSERT 2 SQLCODE: +0000000000", + "INSERT 2 DATA : -000000000000000112", + "INSERT 3 SQLCODE: +0000000000", + "INSERT 3 DATA : 000000000000000237", + "INSERT 4 SQLCODE: +0000000000", + "INSERT 4 DATA : 000000000000000127.220000000000", + "SELECT 1 SQLCODE: +0000000000", + "SELECT 1 DATA : -000000000000000042.740000000000", + "SELECT 2 SQLCODE: +0000000000", + "SELECT 2 DATA : -000000000000000112", + "SELECT 3 SQLCODE: +0000000000", + "SELECT 3 DATA : 000000000000000237", + "SELECT 4 SQLCODE: +0000000000", + "SELECT 4 DATA : 000000000000000127.220000000000", + "RES 1 : OK", + "RES 2 : OK", + "RES 3 : OK", + "RES 4 : OK" + }); + } + + + [TestMethod] + [CobolSource("TSQL019B.cbl")] + [GixSqlDataSource("pgsql", 1)] + public void TSQL019B_MSVC_pgsql_x64_exe() + { + compile(CompilerType.MSVC, "release", "x64", "exe"); + + using (var conn = GetConnection()) + { + try + { + conn.Open(); + using (var cmd = conn.CreateCommand()) + { + cmd.CommandText = "drop table if exists tab_a"; + cmd.ExecuteNonQuery(); + + cmd.CommandText = "create table tab_a (id int, tornw numeric(18,4))"; + cmd.ExecuteNonQuery(); + } + } + finally + { + if (conn != null && conn.State == System.Data.ConnectionState.Open) + conn.Close(); + } + + } + + Environment.SetEnvironmentVariable("DATASRC", build_data_source_string(false, true, true)); + Environment.SetEnvironmentVariable("DATASRC_USR", get_datasource_usr()); + Environment.SetEnvironmentVariable("DATASRC_PWD", get_datasource_pwd()); + + run(CompilerType.MSVC, "release", "x64", "exe", "", false, new string[] { + "INSERT 1 SQLCODE: +0000000000", + "INSERT 1 DATA : -000000000000000042.740000000000", + "INSERT 2 SQLCODE: +0000000000", + "INSERT 2 DATA : -000000000000000112", + "INSERT 3 SQLCODE: +0000000000", + "INSERT 3 DATA : 000000000000000237", + "INSERT 4 SQLCODE: +0000000000", + "INSERT 4 DATA : 000000000000000127.220000000000", + "SELECT 1 SQLCODE: +0000000000", + "SELECT 1 DATA : -000000000000000042.740000000000", + "SELECT 2 SQLCODE: +0000000000", + "SELECT 2 DATA : -000000000000000112", + "SELECT 3 SQLCODE: +0000000000", + "SELECT 3 DATA : 000000000000000237", + "SELECT 4 SQLCODE: +0000000000", + "SELECT 4 DATA : 000000000000000127.220000000000", + "RES 1 : OK", + "RES 2 : OK", + "RES 3 : OK", + "RES 4 : OK" + }); + } + } +} diff --git a/gixsql-tests/TSQL020.cs b/gixsql-tests/TSQL020.cs new file mode 100644 index 00000000..0bf8b911 --- /dev/null +++ b/gixsql-tests/TSQL020.cs @@ -0,0 +1,36 @@ +using gix_ide_tests; +using Microsoft.VisualStudio.TestTools.UnitTesting; +using System; +using System.IO; + +namespace gixsql_tests +{ + [TestClass] + [HostPlatform("x64")] + [TestCategory("Pass postgres cast operator as token (#93)")] + public class TSQL020 : GixSqlTestBase + { + [TestInitialize] + public new void Begin() + { + base.Begin(); + + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG_ON", "1"); + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG", Path.Combine(TestTempDir, "gisql-debug.log")); + Environment.SetEnvironmentVariable("GIXSQL_ERR_LOG", Path.Combine(TestTempDir, "gisql-error.log")); + } + + + [TestMethod] + [CobolSource("TSQL020A.cbl", "EMPREC.cpy")] + [GixSqlDataSource("pgsql", 1)] + public void TSQL020A_MSVC_pgsql_x64_exe() + { + compile(CompilerType.MSVC, "release", "x64", "exe"); + + Console.WriteLine("Performed syntax check only: OK"); + } + + + } +} diff --git a/gixsql-tests/TSQL021.cs b/gixsql-tests/TSQL021.cs new file mode 100644 index 00000000..db543c31 --- /dev/null +++ b/gixsql-tests/TSQL021.cs @@ -0,0 +1,52 @@ +using gix_ide_tests; +using Microsoft.VisualStudio.TestTools.UnitTesting; +using System; +using System.IO; + +namespace gixsql_tests +{ + [TestClass] + [HostPlatform("x64")] + [TestCategory("More formats for connect (#43)")] + public class TSQL021 : GixSqlTestBase + { + [TestInitialize] + public new void Begin() + { + base.Begin(); + + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG_ON", "1"); + Environment.SetEnvironmentVariable("GIXSQL_DEBUG_LOG", Path.Combine(TestTempDir, "gisql-debug.log")); + Environment.SetEnvironmentVariable("GIXSQL_ERR_LOG", Path.Combine(TestTempDir, "gisql-error.log")); + } + + + [TestMethod] + [CobolSource("TSQL021A.cbl", "EMPREC.cpy")] + [GixSqlDataSource("pgsql", 1)] + public void TSQL021A_MSVC_pgsql_x64_exe() + { + compile(CompilerType.MSVC, "release", "x64", "exe"); + + Environment.SetEnvironmentVariable("DATASRC", build_data_source_string(false, true, true)); + Environment.SetEnvironmentVariable("DATASRC_FULL", build_data_source_string(true, true, true)); + Environment.SetEnvironmentVariable("DBUSR", get_datasource_usr()); + Environment.SetEnvironmentVariable("DBPWD", get_datasource_pwd()); + Environment.SetEnvironmentVariable("DBNAME", get_datasource_dbname()); + Environment.SetEnvironmentVariable("DBUSRPWD", get_datasource_usr() + "." + get_datasource_pwd()); + + run(CompilerType.MSVC, "release", "x64", "exe", "", false, new string[] { + "CONNECT 1A SQLCODE: +0000000000", + "CONNECT 2A SQLCODE: +0000000000", + "CONNECT 3A SQLCODE: +0000000000", + "CONNECT 4A SQLCODE: -0000000201", + "CONNECT 5A SQLCODE: +0000000000", + "CONNECT 6A SQLCODE: +0000000000", + "CONNECT 1N SQLCODE: +0000000000", + "CONNECT 2N SQLCODE: +0000000000", + "CONNECT 3N SQLCODE: +0000000000", + "CONNECT 4N SQLCODE: -0000000201" + }); + } + } +} diff --git a/gixsql-tests/data/TSQL006B.cbl b/gixsql-tests/data/TSQL006B.cbl new file mode 100644 index 00000000..10505361 --- /dev/null +++ b/gixsql-tests/data/TSQL006B.cbl @@ -0,0 +1,81 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL006B. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + + 01 S-SQLCOMMAND. + 03 S-SQLCOMMAND-LEN PIC S9(8) COMP-5. + 03 S-SQLCOMMAND-ARR PIC X(250). + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + + DISPLAY '***************************************'. + DISPLAY " DATASRC : " DATASRC. + DISPLAY " AUTH : " DBUSR. + DISPLAY '***************************************'. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'CONNECT SQLCODE. ' SQLCODE + DISPLAY 'CONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + + MOVE EXEC-SQLCOMMAND TO S-SQLCOMMAND-ARR. + MOVE FUNCTION LENGTH(FUNCTION TRIM(S-SQLCOMMAND-ARR)) + TO S-SQLCOMMAND-LEN. + + EXEC SQL AT :DBS + PREPARE P1 FROM :S-SQLCOMMAND + END-EXEC. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL + CONNECT RESET + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'DISCONNECT SQLCODE. ' SQLCODE + DISPLAY 'DISCONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-EXIT. + STOP RUN. diff --git a/gixsql-tests/data/TSQL006C.cbl b/gixsql-tests/data/TSQL006C.cbl new file mode 100644 index 00000000..cd255b98 --- /dev/null +++ b/gixsql-tests/data/TSQL006C.cbl @@ -0,0 +1,98 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL006C. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + + 01 EXEC-SQLCOMMAND PIC X(100) VALUE 'SELECT 1'. + + 01 S-SQLCOMMAND. + 49 S-SQLCOMMAND-LEN PIC S9(8) COMP-5. + 49 S-SQLCOMMAND-ARR PIC X(250). + + 01 S-SQLCOMMAND-2 PIC X(250). + + 01 S-SQLCOMMAND-3. + 03 S-SQLCOMMAND-3-LEN PIC S9(8) COMP-5. + 03 S-SQLCOMMAND-3-ARR PIC X(250). + + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY '***************************************'. + DISPLAY " DATASRC : " DATASRC. + DISPLAY " AUTH : " DBUSR. + DISPLAY '***************************************'. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'CONNECT SQLCODE. ' SQLCODE + DISPLAY 'CONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + + MOVE EXEC-SQLCOMMAND TO S-SQLCOMMAND-ARR. + MOVE FUNCTION LENGTH(FUNCTION TRIM(S-SQLCOMMAND-ARR)) + TO S-SQLCOMMAND-LEN. + + EXEC SQL + PREPARE P1 FROM :S-SQLCOMMAND + END-EXEC. + + EXEC SQL + PREPARE P2 FROM :S-SQLCOMMAND-2 + END-EXEC. + + EXEC SQL + PREPARE P2 FROM :S-SQLCOMMAND-3-ARR + END-EXEC. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL + CONNECT RESET + END-EXEC. + + IF SQLCODE <> 0 THEN + DISPLAY 'DISCONNECT SQLCODE. ' SQLCODE + DISPLAY 'DISCONNECT SQLERRM. ' SQLERRM + GO TO 100-EXIT + END-IF. + + 100-EXIT. + STOP RUN. diff --git a/gixsql-tests/data/TSQL007A.cbl b/gixsql-tests/data/TSQL007A.cbl index 22bfae4f..568b0605 100644 --- a/gixsql-tests/data/TSQL007A.cbl +++ b/gixsql-tests/data/TSQL007A.cbl @@ -440,8 +440,17 @@ 041600 COMP-FOOT-EXIT. 041700 EXIT. 041800 + +035800 DO-FILE SECTION. + +035800*DO-WORKING-STORAGE SECTION. + +035800 DO-LINKAGE SECTION. + 041900 END DECLARATIVES. 042000 + + 042100 000-INITIATE. 042200 042300 OPEN INPUT PAYROLL-REGISTER-DATA, diff --git a/gixsql-tests/data/TSQL012A.cbl b/gixsql-tests/data/TSQL012A.cbl index 4cf68bcd..2d22e36c 100644 --- a/gixsql-tests/data/TSQL012A.cbl +++ b/gixsql-tests/data/TSQL012A.cbl @@ -29,6 +29,10 @@ 01 T1 PIC 9(3) VALUE 0. 01 TABROWID PIC 9(8) VALUE 0. + 01 DESCRIPTOR PIC 9(8) VALUE 0. + 01 OID PIC 9(8) VALUE 0. + 01 LEN PIC 9(8) VALUE 0. + 01 RES PIC 9(8) VALUE 0. EXEC SQL INCLUDE SQLCA @@ -70,6 +74,16 @@ REFNR = :T1) END-EXEC. + * EXEC SQL + * SELECT LEN INTO :LEN FROM TAB WHERE OID=:OID + * END-EXEC. + * + * EXEC SQL + * SELECT lo_close (:DESCRIPTOR) INTO :RES + * FROM TAB + * WHERE OID=:OID + * END-EXEC. + DISPLAY 'SELECT SQLCODE: ' SQLCODE. IF SQLCODE <> 0 THEN diff --git a/gixsql-tests/data/TSQL015A.cbl b/gixsql-tests/data/TSQL015A.cbl index f5b7b19a..d93c5e0b 100644 --- a/gixsql-tests/data/TSQL015A.cbl +++ b/gixsql-tests/data/TSQL015A.cbl @@ -18,15 +18,15 @@ WORKING-STORAGE SECTION. - EXEC SQL - INCLUDE EMPREC - END-EXEC. - 01 DATASRC PIC X(64). 01 DBS PIC X(64). 01 DBUSR PIC X(64). 01 DBPWD PIC X(64). + + 01 Z-MY-ELEMENTS PIC 9(8). + 78 MY-CONSTANT VALUE 16. + EXEC SQL INCLUDE SQLCA END-EXEC. @@ -39,7 +39,22 @@ 05 FILLER OCCURS UNBOUNDED DEPENDING ON L-DYNBUFFER-LEN PIC X. + + 01 L-DYNBUFFER. + 05 FILLER OCCURS 0 TO MY-CONSTANT TIMES + DEPENDING ON L-DYNBUFFER-LEN + PIC X. + 01 MY-TAB. + 05 MY-NO PIC 9(009) COMP-5 VALUE ZERO. + 05 MY-TAB-CACHE OCCURS 100 + DEPENDING ON Z-MY-ELEMENTS + ASCENDING KEY IS MY-ID + INDEXED BY I-TAB. + 07 MY-ELEMENT. + 10 MY-ID PIC 9(009) COMP-5 VALUE ZERO. + 10 MY-DATA PIC X(02189) VALUE SPACE. + PROCEDURE DIVISION. 000-CONNECT. diff --git a/gixsql-tests/data/TSQL018A.cbl b/gixsql-tests/data/TSQL018A.cbl new file mode 100644 index 00000000..17622dfe --- /dev/null +++ b/gixsql-tests/data/TSQL018A.cbl @@ -0,0 +1,126 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL018A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + + 01 DATA-01 PIC X(64). + 01 DATA-02 PIC X(64). + 01 DATA-03 PIC X(64). + 01 DATA-04 PIC X(64). + 01 DATA-05 PIC X(64). + 01 DATA-06 PIC X(64). + 01 DATA-07 PIC X(64). + 01 DATA-08 PIC X(64). + 01 DATA-09 PIC X(64). + 01 DATA-10 PIC X(64). + 01 DATA-11 PIC X(64). + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL + SELECT + GENEX.CASE_BARCODE AS CASE_BARCODE, + GENEX.SAMPLE_BARCODE AS SAMPLE_BARCODE, + GENEX.ALIQUOT_BARCODE AS ALIQUOT_BARCODE, + GENEX.HGNC_GENE_SYMBOL AS HGNC_GENE_SYMBOL, + CLINICAL_INFO.VARIANT_TYPE AS VARIANT_TYPE, + GENEX.GENE_ID AS GENE_ID, + GENEX.NORMALIZED_COUNT AS NORMALIZED_COUNT, + GENEX.PROJECT_SHORT_NAME AS PROJECT_SHORT_NAME, + CLINICAL_INFO.DEMO__GENDER AS GENDER, + CLINICAL_INFO.DEMO__VITAL_STATUS AS VITAL_STATUS, + CLINICAL_INFO.DEMO__DAYS_TO_DEATH AS DAYS_TO_DEATH + INTO + :DATA-01, :DATA-02, :DATA-03, :DATA-04, + :DATA-05, :DATA-06, :DATA-07, :DATA-08, + :DATA-09, :DATA-10, :DATA-11 + FROM ( + SELECT + CASE_LIST.VARIANT_TYPE AS VARIANT_TYPE, + CASE_LIST.CASE_BARCODE AS CASE_BARCODE, + CLINICAL.DEMO__GENDER, + CLINICAL.DEMO__VITAL_STATUS, + CLINICAL.DEMO__DAYS_TO_DEATH + FROM + (SELECT + MUTATION.CASE_BARCODE, + MUTATION.VARIANT_TYPE + FROM + ISB-CGC-BQ.TCGA_VERSIONED.SM_HG19_DCC_02 AS MUTATION + WHERE + MUTATION.HUGO_SYMBOL = 'CDKN2A' + AND PROJECT_SHORT_NAME = 'TCGA-BLCA' + GROUP BY + MUTATION.CASE_BARCODE, + MUTATION.VARIANT_TYPE + ORDER BY + MUTATION.CASE_BARCODE + ) AS CASE_LIST + INNER JOIN + ISB-CGC-BQ.TCGA.CLINICAL_GDC_CURRENT AS CLINICAL + ON + CASE_LIST.CASE_BARCODE = CLINICAL.SUBMITTER_ID ) + AS CLINICAL_INFO + INNER JOIN + ISB-CGC-BQ.TCGA_VERSIONED.RNASEQ_HG19_GDC_2017_02 + AS GENEX + ON + GENEX.CASE_BARCODE = CLINICAL_INFO.CASE_BARCODE + WHERE + GENEX.HGNC_GENE_SYMBOL IN + ('MDM2', 'TP53', 'CDKN1A','CCNE1') + ORDER BY + CASE_BARCODE, + HGNC_GENE_SYMBOL + END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + 100-EXIT. + STOP RUN. + + 200-END. diff --git a/gixsql-tests/data/TSQL019A.cbl b/gixsql-tests/data/TSQL019A.cbl new file mode 100644 index 00000000..266b12c5 --- /dev/null +++ b/gixsql-tests/data/TSQL019A.cbl @@ -0,0 +1,207 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL019A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + + 01 REC-ID PIC 9(4). + + 01 TORNW-1 PIC S9(018)V9(12) COMP-3. + 01 TORNW-2 PIC S9(018) COMP-3. + 01 TORNW-3 PIC 9(018) COMP-3. + 01 TORNW-4 PIC 9(018)V9(12) COMP-3. + + 01 TORNR-1 PIC S9(018)V9(12) COMP-3. + 01 TORNR-2 PIC S9(018) COMP-3. + 01 TORNR-3 PIC 9(018) COMP-3. + 01 TORNR-4 PIC 9(018)V9(12) COMP-3. + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + DISPLAY 'START TRANSACTION SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + + * EXEC SQL TRUNCATE TABLE TAB_A END-EXEC. + + MOVE 1 TO REC-ID. + MOVE -42.74 TO TORNW-1. + + * PIC S9(018)V9(12) COMP-3. + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-1) + END-EXEC. + DISPLAY 'INSERT 1 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 1 DATA : ' TORNW-1. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 2 TO REC-ID. + MOVE -112 TO TORNW-2. + + * PIC S9(018) COMP-3. + + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-2) + END-EXEC. + DISPLAY 'INSERT 2 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 2 DATA : ' TORNW-2. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 3 TO REC-ID. + MOVE 237 TO TORNW-3. + + * PIC 9(018) COMP-3. + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-3) + END-EXEC. + DISPLAY 'INSERT 3 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 3 DATA : ' TORNW-3. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 4 TO REC-ID. + MOVE 127.22 TO TORNW-4. + + * PIC 9(018)V9(12) COMP-3. + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-4) + END-EXEC. + DISPLAY 'INSERT 4 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 4 DATA : ' TORNW-4. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * read tests + + EXEC SQL + SELECT TORNW INTO :TORNR-1 FROM TAB_A + WHERE ID = 1 + END-EXEC. + DISPLAY 'SELECT 1 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 1 DATA : ' TORNR-1. + + EXEC SQL + SELECT TORNW INTO :TORNR-2 FROM TAB_A + WHERE ID = 2 + END-EXEC. + DISPLAY 'SELECT 2 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 2 DATA : ' TORNR-2. + + EXEC SQL + SELECT TORNW INTO :TORNR-3 FROM TAB_A + WHERE ID = 3 + END-EXEC. + DISPLAY 'SELECT 3 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 3 DATA : ' TORNR-3. + + EXEC SQL + SELECT TORNW INTO :TORNR-4 FROM TAB_A + WHERE ID = 4 + END-EXEC. + DISPLAY 'SELECT 4 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 4 DATA : ' TORNR-4. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + IF TORNW-1 = TORNR-1 THEN + DISPLAY 'RES 1 : OK' + ELSE + DISPLAY 'RES 1 : KO' + END-IF. + + IF TORNW-2 = TORNR-2 THEN + DISPLAY 'RES 2 : OK' + ELSE + DISPLAY 'RES 2 : KO' + END-IF. + + IF TORNW-3 = TORNR-3 THEN + DISPLAY 'RES 3 : OK' + ELSE + DISPLAY 'RES 3 : KO' + END-IF. + + IF TORNW-4 = TORNR-4 THEN + DISPLAY 'RES 4 : OK' + ELSE + DISPLAY 'RES 4 : KO' + END-IF. + 100-EXIT. + + IF SQLCODE <> 0 THEN + DISPLAY 'SQLERRM ' SQLERRM + END-IF. + + STOP RUN. + + 200-END. diff --git a/gixsql-tests/data/TSQL019B.cbl b/gixsql-tests/data/TSQL019B.cbl new file mode 100644 index 00000000..817192a6 --- /dev/null +++ b/gixsql-tests/data/TSQL019B.cbl @@ -0,0 +1,208 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL019B. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + 01 DATASRC PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + + 01 REC-ID PIC 9(4). + + 01 TORNW-1 PIC S9(018)V9(12) . + 01 TORNW-2 PIC S9(018) . + 01 TORNW-3 PIC 9(018) . + 01 TORNW-4 PIC 9(018)V9(12) . + + 01 TORNR-1 PIC S9(018)V9(12) . + 01 TORNR-2 PIC S9(018) . + 01 TORNR-3 PIC 9(018) . + 01 TORNR-4 PIC 9(018)V9(12) . + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL START TRANSACTION END-EXEC. + DISPLAY 'START TRANSACTION SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + + EXEC SQL TRUNCATE TABLE TAB_A END-EXEC. + + MOVE 1 TO REC-ID. + MOVE -42.74 TO TORNW-1. + + * PIC S9(018)V9(12) . + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-1) + END-EXEC. + DISPLAY 'INSERT 1 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 1 DATA : ' TORNW-1. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 2 TO REC-ID. + MOVE -112 TO TORNW-2. + + * PIC S9(018) . + + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-2) + END-EXEC. + DISPLAY 'INSERT 2 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 2 DATA : ' TORNW-2. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 3 TO REC-ID. + MOVE 237 TO TORNW-3. + + * PIC 9(018) . + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-3) + END-EXEC. + DISPLAY 'INSERT 3 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 3 DATA : ' TORNW-3. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + MOVE 4 TO REC-ID. + MOVE 127.22 TO TORNW-4. + + * PIC 9(018)V9(12) . + + EXEC SQL + INSERT INTO TAB_A(ID, TORNW) VALUES (:REC-ID, :TORNW-4) + END-EXEC. + DISPLAY 'INSERT 4 SQLCODE: ' SQLCODE. + DISPLAY 'INSERT 4 DATA : ' TORNW-4. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * read tests + + EXEC SQL + SELECT TORNW INTO :TORNR-1 FROM TAB_A + WHERE ID = 1 + END-EXEC. + DISPLAY 'SELECT 1 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 1 DATA : ' TORNR-1. + + EXEC SQL + SELECT TORNW INTO :TORNR-2 FROM TAB_A + WHERE ID = 2 + END-EXEC. + DISPLAY 'SELECT 2 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 2 DATA : ' TORNR-2. + + EXEC SQL + SELECT TORNW INTO :TORNR-3 FROM TAB_A + WHERE ID = 3 + END-EXEC. + DISPLAY 'SELECT 3 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 3 DATA : ' TORNR-3. + + EXEC SQL + SELECT TORNW INTO :TORNR-4 FROM TAB_A + WHERE ID = 4 + END-EXEC. + DISPLAY 'SELECT 4 SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + DISPLAY 'SELECT 4 DATA : ' TORNR-4. + + EXEC SQL COMMIT END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + IF TORNW-1 = TORNR-1 THEN + DISPLAY 'RES 1 : OK' + ELSE + DISPLAY 'RES 1 : KO' + END-IF. + + IF TORNW-2 = TORNR-2 THEN + DISPLAY 'RES 2 : OK' + ELSE + DISPLAY 'RES 2 : KO' + END-IF. + + IF TORNW-3 = TORNR-3 THEN + DISPLAY 'RES 3 : OK' + ELSE + DISPLAY 'RES 3 : KO' + END-IF. + + IF TORNW-4 = TORNR-4 THEN + DISPLAY 'RES 4 : OK' + ELSE + DISPLAY 'RES 4 : KO' + END-IF. + + 100-EXIT. + + IF SQLCODE <> 0 THEN + DISPLAY 'SQLERRM ' SQLERRM + END-IF. + + STOP RUN. + + 200-END. diff --git a/gixsql-tests/data/TSQL020A.cbl b/gixsql-tests/data/TSQL020A.cbl new file mode 100644 index 00000000..2f7a6389 --- /dev/null +++ b/gixsql-tests/data/TSQL020A.cbl @@ -0,0 +1,76 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL020A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + EXEC SQL + INCLUDE EMPREC + END-EXEC. + + 01 DATASRC PIC X(64). + 01 DBS PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + 01 BLOB1 PIC X(64). + + 01 LEN PIC 9(8) COMP-3. + 01 OFFSET PIC 9(8) COMP-3. + 01 REC1 PIC X(1000000). + + 01 VAR1 PIC 9(3) VALUE 0. + 01 VAR2 PIC 9(3) VALUE 0. + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_USR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + DISPLAY "DATASRC_PWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + + DISPLAY 'CONNECT SQLCODE: ' SQLCODE + + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + 100-MAIN. + + EXEC SQL AT :DBS + SELECT VAR1::numeric + INTO :VAR1 + FROM TAB + WHERE :VAR2::numeric = 10 + END-EXEC. + + EXEC SQL CONNECT RESET END-EXEC. + + 100-EXIT. + STOP RUN. + + 200-END. diff --git a/gixsql-tests/data/TSQL021A.cbl b/gixsql-tests/data/TSQL021A.cbl new file mode 100644 index 00000000..769bd54e --- /dev/null +++ b/gixsql-tests/data/TSQL021A.cbl @@ -0,0 +1,198 @@ + IDENTIFICATION DIVISION. + + PROGRAM-ID. TSQL021A. + + + ENVIRONMENT DIVISION. + + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-AT. + OBJECT-COMPUTER. IBM-AT. + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + DATA DIVISION. + + FILE SECTION. + + WORKING-STORAGE SECTION. + + EXEC SQL + INCLUDE EMPREC + END-EXEC. + + 01 DATASRC PIC X(64). + 01 DATASRC-FULL PIC X(64). + 01 DBS PIC X(64). + 01 DBUSR PIC X(64). + 01 DBPWD PIC X(64). + 01 DBUSRPWD PIC X(128). + 01 DBNAME PIC X(64). + + 01 T1 PIC 9(4). + + EXEC SQL + INCLUDE SQLCA + END-EXEC. + + PROCEDURE DIVISION. + + 000-CONNECT. + DISPLAY "DATASRC_FULL" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC-FULL FROM ENVIRONMENT-VALUE. + + DISPLAY "DATASRC" UPON ENVIRONMENT-NAME. + ACCEPT DATASRC FROM ENVIRONMENT-VALUE. + + DISPLAY "DBUSR" UPON ENVIRONMENT-NAME. + ACCEPT DBUSR FROM ENVIRONMENT-VALUE. + + DISPLAY "DBPWD" UPON ENVIRONMENT-NAME. + ACCEPT DBPWD FROM ENVIRONMENT-VALUE. + + DISPLAY "DBNAME" UPON ENVIRONMENT-NAME. + ACCEPT DBNAME FROM ENVIRONMENT-VALUE. + + DISPLAY "DBUSRPWD" UPON ENVIRONMENT-NAME. + ACCEPT DBUSRPWD FROM ENVIRONMENT-VALUE. + + 100-MAIN. + + MOVE 'CONN1' TO DBS + + * mode 1 (anonymous) + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSR USING :DBPWD + END-EXEC. + DISPLAY 'CONNECT 1A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET END-EXEC. + + * mode 2 (anonymous) + + EXEC SQL + CONNECT TO :DATASRC USER :DBUSRPWD + END-EXEC. + DISPLAY 'CONNECT 2A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET END-EXEC. + + * mode 3 (anonymous) + + EXEC SQL + CONNECT :DBUSR + IDENTIFIED BY :DBPWD + USING :DATASRC + END-EXEC. + DISPLAY 'CONNECT 3A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET END-EXEC. + + * mode 4 (anonymous) - Unsupported - emit a preproc warning + + EXEC SQL + CONNECT :DBUSR IDENTIFIED BY :DBPWD + END-EXEC. + DISPLAY 'CONNECT 4A SQLCODE: ' SQLCODE. + + * we ignore the error for mode 4 + * IF SQLCODE <> 0 THEN + * GO TO 100-EXIT + * END-IF. + + * mode 5 (anonymous) + + EXEC SQL + CONNECT USING :DATASRC-FULL + END-EXEC. + DISPLAY 'CONNECT 5A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * mode 6 (anonymous) + + EXEC SQL + CONNECT TO :DBNAME + USER :DBUSR + USING :DATASRC + IDENTIFIED BY :DBPWD + END-EXEC. + DISPLAY 'CONNECT 6A SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + * mode 1 (named) + + EXEC SQL + CONNECT TO :DATASRC AS :DBS USER :DBUSR USING :DBPWD + END-EXEC. + DISPLAY 'CONNECT 1N SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET :DBS END-EXEC. + + * mode 2 (named) + + EXEC SQL + CONNECT TO :DATASRC AS :DBS USER :DBUSRPWD + END-EXEC. + DISPLAY 'CONNECT 2N SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET :DBS END-EXEC. + + * mode 3 (named) + + EXEC SQL + CONNECT :DBUSR + IDENTIFIED BY :DBPWD + AT :DBS + USING :DATASRC + END-EXEC. + DISPLAY 'CONNECT 3N SQLCODE: ' SQLCODE. + IF SQLCODE <> 0 THEN + GO TO 100-EXIT + END-IF. + + EXEC SQL CONNECT RESET :DBS END-EXEC. + + * mode 4 (named) - Unsupported - emit a preproc warning + + EXEC SQL + CONNECT :DBUSR IDENTIFIED BY :DBPWD + AT :DBS + END-EXEC. + DISPLAY 'CONNECT 4N SQLCODE: ' SQLCODE. + + * we ignore the error for mode 4 + * IF SQLCODE <> 0 THEN + * GO TO 100-EXIT + * END-IF. + + * last step, we need to "force" the error code, otherwise the test will fail + + MOVE 0 TO RETURN-CODE. + + * mode 5 and 6 do not support named connections + + 100-EXIT. + STOP RUN. + + 200-END. diff --git a/gixsql-tests/gixsql-tests.csproj b/gixsql-tests/gixsql-tests.csproj index 4d20704f..955678a9 100644 --- a/gixsql-tests/gixsql-tests.csproj +++ b/gixsql-tests/gixsql-tests.csproj @@ -142,6 +142,10 @@ + + + + @@ -187,6 +191,13 @@ + + + + + + + diff --git a/gixsql/libgixsql/SqlVar.cpp b/gixsql/libgixsql/SqlVar.cpp index 0c093df0..c1447fdb 100644 --- a/gixsql/libgixsql/SqlVar.cpp +++ b/gixsql/libgixsql/SqlVar.cpp @@ -135,7 +135,7 @@ void SqlVar::createRealData() } if (power < 0) { - insert_decimal_point(realdata, realdata_len, power); + insert_decimal_point(realdata, realdata_len + SIGN_LENGTH, power); } LOG_DEBUG(__FILE__, __func__, "%d %d->#data:%s#realdata:%s\n", type, length, addr, realdata); @@ -146,7 +146,7 @@ void SqlVar::createRealData() memcpy(realdata, addr, realdata_len); if (power < 0) { - insert_decimal_point(realdata, realdata_len, power); + insert_decimal_point(realdata, realdata_len + SIGN_LENGTH, power); } LOG_DEBUG(__FILE__, __func__, "%d %d->#data:%s#realdata:%s\n", type, length, addr, realdata); @@ -243,7 +243,7 @@ void SqlVar::createRealData() } if (power < 0) { - insert_decimal_point(realdata, realdata_len, power); + insert_decimal_point(realdata, realdata_len + SIGN_LENGTH, power); } LOG_DEBUG(__FILE__, __func__, "%d %d->#data:%s#realdata:%s\n", type, length, addr, realdata); @@ -375,7 +375,7 @@ void SqlVar::createCobolData(char *retstr, int datalen) case COBOL_TYPE_UNSIGNED_NUMBER: { char* ptr; - int fillzero; + int int_fillzero; // before decimal point int beforedp = 0; @@ -388,13 +388,12 @@ void SqlVar::createCobolData(char *retstr, int datalen) } } - fillzero = length - beforedp + power; - if (fillzero < 0) - fillzero = 0; + int_fillzero = length - beforedp + power; + if (int_fillzero < 0) + int_fillzero = 0; - memset(addr, ASCII_ZERO, fillzero); - - memcpy((uint8_t *)addr + fillzero, retstr, beforedp); + memset(addr, ASCII_ZERO, int_fillzero); + memcpy((uint8_t *)addr + int_fillzero, retstr, beforedp); if (power < 0) { int afterdp = 0; @@ -408,13 +407,13 @@ void SqlVar::createCobolData(char *retstr, int datalen) } // fill zero - memcpy((uint8_t*)addr + fillzero + beforedp, + memcpy((uint8_t*)addr + int_fillzero + beforedp, retstr + beforedp + DECIMAL_LENGTH, afterdp); } - fillzero = -power - afterdp; - uint8_t* ptr = ((uint8_t*)addr + fillzero + beforedp) + afterdp; - memset(ptr, ASCII_ZERO, fillzero); + int dec_fillzero = -power - afterdp; + uint8_t* ptr = ((uint8_t*)addr + int_fillzero + beforedp) + afterdp; + memset(ptr, ASCII_ZERO, dec_fillzero); } break; } @@ -424,7 +423,7 @@ void SqlVar::createCobolData(char *retstr, int datalen) char* ptr; int is_negative = false; - int fillzero; + int int_fillzero; int final_length; if (retstr[0] == '-') { @@ -446,12 +445,12 @@ void SqlVar::createCobolData(char *retstr, int datalen) } } - fillzero = length - beforedp + power; - if (fillzero < 0) - fillzero = 0; + int_fillzero = length - beforedp + power; + if (int_fillzero < 0) + int_fillzero = 0; - memset(addr, ASCII_ZERO, fillzero); - memcpy((uint8_t *)addr + fillzero, value, beforedp); + memset(addr, ASCII_ZERO, int_fillzero); + memcpy((uint8_t *)addr + int_fillzero, value, beforedp); if (power < 0) { int afterdp = 0; @@ -463,14 +462,14 @@ void SqlVar::createCobolData(char *retstr, int datalen) for (; *ptr != '\0'; ptr++) { afterdp++; } - memcpy((uint8_t*)addr + fillzero + beforedp, value + + memcpy((uint8_t*)addr + int_fillzero + beforedp, value + beforedp + DECIMAL_LENGTH, afterdp); } // fill zero - fillzero = -power - afterdp; - uint8_t* ptr = ((uint8_t*)addr + fillzero + beforedp) + afterdp; - memset(ptr, ASCII_ZERO, fillzero); + int dec_fillzero = -power - afterdp; + uint8_t* ptr = ((uint8_t*)addr + int_fillzero + beforedp) + afterdp; + memset(ptr, ASCII_ZERO, dec_fillzero); } @@ -487,7 +486,7 @@ void SqlVar::createCobolData(char *retstr, int datalen) unsigned char* value; unsigned char* ptr; - int fillzero; + int int_fillzero; if (retstr[0] == '-') { ((uint8_t *)addr)[0] = '-'; @@ -509,10 +508,10 @@ void SqlVar::createCobolData(char *retstr, int datalen) } } - fillzero = length - beforedp + power; - memset(addr, ASCII_ZERO, fillzero); + int_fillzero = length - beforedp + power; + memset(addr, ASCII_ZERO, int_fillzero); - memcpy((uint8_t *)addr + SIGN_LENGTH + fillzero, value, beforedp); + memcpy((uint8_t *)addr + SIGN_LENGTH + int_fillzero, value, beforedp); if (power < 0) { int afterdp = 0; @@ -526,13 +525,13 @@ void SqlVar::createCobolData(char *retstr, int datalen) } // fill zero - memcpy((uint8_t*)addr + SIGN_LENGTH + fillzero + beforedp, + memcpy((uint8_t*)addr + SIGN_LENGTH + int_fillzero + beforedp, value + beforedp + DECIMAL_LENGTH, afterdp); } - fillzero = -power - afterdp; - ptr = ((uint8_t*)addr + SIGN_LENGTH + fillzero + beforedp) + afterdp; - memset(ptr, ASCII_ZERO, fillzero); + int dec_fillzero = -power - afterdp; + ptr = ((uint8_t*)addr + SIGN_LENGTH + int_fillzero + beforedp) + afterdp; + memset(ptr, ASCII_ZERO, dec_fillzero); } break; } @@ -712,15 +711,20 @@ void SqlVar::display_to_comp3(const char *data, bool has_sign) // , int total_le } } - unsigned int disp_intpart_len = this->length - this->power; + unsigned int abs_power = abs(this->power); + unsigned int disp_intpart_len = this->length - abs_power; + unsigned int disp_decpart_len = abs_power; data_has_sign = (has_sign && (*data == '-') || (*data == '+')); if (has_sign && *data == '-') { is_negative = true; } + // check for truncation (integer part) memcpy(tmp + (disp_intpart_len - data_intpart_len), data + (data_has_sign ? 1 : 0), data_intpart_len); - memcpy(tmp + disp_intpart_len, data + data_intpart_len + DECIMAL_LENGTH + (data_has_sign ? 1 : 0), data_decpart_len); + + // check for truncation (decimal part) + memcpy(tmp + disp_intpart_len, data + data_intpart_len + DECIMAL_LENGTH + (data_has_sign ? 1 : 0), disp_decpart_len); // convert int i; // string index diff --git a/libcpputils/linq/linq_iterators.hpp b/libcpputils/linq/linq_iterators.hpp index 3472281b..9fec7ab0 100644 --- a/libcpputils/linq/linq_iterators.hpp +++ b/libcpputils/linq/linq_iterators.hpp @@ -162,7 +162,7 @@ namespace cpplinq { private: bool empty() const { - !cur || cur->empty(); + return !cur || cur->empty(); } util::maybe cur; diff --git a/libgixpp/ESQLDefinitions.h b/libgixpp/ESQLDefinitions.h index 4a28327a..b07b91f2 100644 --- a/libgixpp/ESQLDefinitions.h +++ b/libgixpp/ESQLDefinitions.h @@ -79,9 +79,11 @@ struct esql_connection_info_t hostref_or_literal_t *data_source = nullptr; hostref_or_literal_t *username = nullptr; hostref_or_literal_t *password = nullptr; + + // for compatibility + hostref_or_literal_t *dbname = nullptr; }; - struct cb_exec_sql_stmt_t { int startLine; @@ -186,4 +188,13 @@ struct cb_field_t }; -//} \ No newline at end of file + + +// Parser helper +struct connect_to_info_t +{ + int type = 0; + hostref_or_literal_t *t1 = nullptr; + hostref_or_literal_t *t2 = nullptr; +}; + diff --git a/libgixpp/GixPreProcessor.cpp b/libgixpp/GixPreProcessor.cpp index cabd96bd..80bd94e1 100644 --- a/libgixpp/GixPreProcessor.cpp +++ b/libgixpp/GixPreProcessor.cpp @@ -27,7 +27,7 @@ USA. #include "TPESQLProcessing.h" -#define SET_ERR(I,S) err_data.err_code = I; err_data.err_messages.push_back(S) +#define SET_PP_ERR(I,S) err_data.err_code = I; err_data.err_messages.push_back(S) GixPreProcessor::GixPreProcessor() { @@ -96,17 +96,17 @@ static std::string variant_to_string(const variant &input) bool GixPreProcessor::process() { if (input_file.empty()) { - SET_ERR(1, "Bad input file"); + SET_PP_ERR(1, "Bad input file"); return false; } if (!std::get(getOpt("no_output")) && output_file.empty()) { - SET_ERR(2, "Bad output file"); + SET_PP_ERR(2, "Bad output file"); return false; } if (!file_exists(input_file)) { - SET_ERR(4, "Input file does not exist"); + SET_PP_ERR(4, "Input file does not exist"); return false; } diff --git a/libgixpp/TPESQLProcessing.cpp b/libgixpp/TPESQLProcessing.cpp index 28b56e72..cc777e72 100644 --- a/libgixpp/TPESQLProcessing.cpp +++ b/libgixpp/TPESQLProcessing.cpp @@ -198,6 +198,7 @@ TPESQLProcessing::TPESQLProcessing(GixPreProcessor *gpp) : ITransformationStep(g opt_consolidated_map = std::get(gpp->getOpt("consolidated_map", false)); opt_no_output = std::get(gpp->getOpt("no_output", false)); opt_emit_map_file = std::get(gpp->getOpt("emit_map_file", false)); + opt_emit_cobol85 = std::get(gpp->getOpt("emit_cobol85", false)); output_line = 0; working_begin_line = 0; @@ -432,7 +433,6 @@ bool TPESQLProcessing::processNextFile() // Add ESQL calls if (!handle_esql_stmt(cmd, exec_sql_stmt, in_ws)) { - //owner->err_data.err_messages.push_back(string_format("Error in ESQL statement at line %d of file %s: %s", input_line, input_file, cur_line)); main_module_driver.error("Error in ESQL statement", ERR_ALREADY_SET); return false; } @@ -441,7 +441,6 @@ bool TPESQLProcessing::processNextFile() // Special case if (exec_sql_stmt->endLine == working_end_line) { if (!handle_esql_stmt(ESQL_Command::WorkingEnd, find_esql_cmd(ESQL_WORKING_END, 0), 0)) { - //owner->err_data.err_messages.push_back(string_format("Error in ESQL statement at line %d of file %s: %s", input_line, input_file, cur_line)); main_module_driver.error("Error in ESQL statement", ERR_ALREADY_SET); return false; } @@ -485,38 +484,77 @@ std::string take_max(std::string &s, int n) return res; } -void TPESQLProcessing::put_query_defs() +bool TPESQLProcessing::put_query_defs() { if (emitted_query_defs) - return; + return true; + for (int i = 1; i <= ws_query_list.size(); i++) { std::string qry = ws_query_list.at(i - 1); int qry_len = qry.length(); qry = string_replace(qry, "\"", "\"\""); + put_output_line(code_tag + string_format(" 01 SQ%04d.", i)); - int pos = 0; - int max_sec_len = 30; + if (!opt_emit_cobol85) { + + if (qry.size() >= 8192) { + auto stmt = main_module_driver.exec_list->at(i - 1); + std::string msg = string_format("Query too long (%d bytes > 8191)", qry.size()); + main_module_driver.error(msg, ERR_QUERY_TOO_LONG, stmt->src_abs_path, stmt->startLine); + return false; + } - std::string s; + int pos = 0; + int max_sec_len = 30; - s = take_max(qry, 30); - put_output_line(code_tag + string_format(" 02 FILLER PIC X(%d) VALUE \"%s\"", qry_len, s)); + std::string s; - while (true) { - s = take_max(qry, 58); - if (s.empty()) - break; + s = take_max(qry, 30); + put_output_line(code_tag + string_format(" 02 FILLER PIC X(%d) VALUE \"%s\"", qry_len, s)); + + while (true) { + s = take_max(qry, 58); + if (s.empty()) + break; + + put_output_line(code_tag + string_format(" & \"%s\"", s)); + } + output_lines.back() += "."; - put_output_line(code_tag + string_format(" & \"%s\"", s)); + put_output_line(code_tag + std::string(" 02 FILLER PIC X(1) VALUE X\"00\".")); } - output_lines.back() += "."; + else { + int pos = 0; + int max_sec_len = 30; + + std::string s; + + while (true) { + std::string sub_block = take_max(qry, 256); + int sb_size = sub_block.size(); + if (sub_block.empty()) + break; + + s = take_max(sub_block, 34); + put_output_line(code_tag + string_format(" 02 FILLER PIC X(%d) VALUE \"%s", sb_size, s)); - put_output_line(code_tag + std::string(" 02 FILLER PIC X(1) VALUE X\"00\".")); + while (true) { + s = take_max(sub_block, 59); + if (s.empty()) + break; + + put_output_line(code_tag + string_format("- \"%s", s)); + } + + output_lines.back() += "\"."; + } + } } emitted_query_defs = true; + return true; } void TPESQLProcessing::put_working_storage() @@ -526,7 +564,7 @@ void TPESQLProcessing::put_working_storage() bool TPESQLProcessing::put_cursor_declarations() { - int f_type, f_size, f_scale, f_flags; + int f_type, f_size, f_scale; bool emit_static = opt_emit_static_calls; if (!startup_items.size()) @@ -555,7 +593,7 @@ bool TPESQLProcessing::put_cursor_declarations() p_call.addParameter(f_type, BY_VALUE); p_call.addParameter(f_size, BY_VALUE); - p_call.addParameter(f_scale, BY_VALUE); + p_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); p_call.addParameter(flags, BY_VALUE); p_call.addParameter(p->hostreference.substr(1), BY_REFERENCE); @@ -659,7 +697,7 @@ void TPESQLProcessing::put_output_line(const std::string &line) bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sql_stmt_ptr stmt, bool in_ws) { - int f_type, f_size, f_scale, f_flags; + int f_type, f_size, f_scale; bool emit_static = opt_emit_static_calls; if (stmt->startup_item) @@ -676,7 +714,9 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq break; case ESQL_Command::WorkingEnd: - put_query_defs(); + if (!put_query_defs()) + return false; + break; case ESQL_Command::Incfile: @@ -781,7 +821,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq rp_call.addParameter(f_type, BY_VALUE); rp_call.addParameter(f_size, BY_VALUE); - rp_call.addParameter(f_scale, BY_VALUE); + rp_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); rp_call.addParameter(flags, BY_VALUE); rp_call.addParameter(rp->hostreference.substr(1), BY_REFERENCE); @@ -806,7 +846,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq p_call.addParameter(f_type, BY_VALUE); p_call.addParameter(f_size, BY_VALUE); - p_call.addParameter(f_scale, BY_VALUE); + p_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); p_call.addParameter(flags, BY_VALUE); p_call.addParameter(p->hostreference.substr(1), BY_REFERENCE); @@ -893,7 +933,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq rp_call.addParameter(f_type, BY_VALUE); rp_call.addParameter(f_size, BY_VALUE); - rp_call.addParameter(f_scale, BY_VALUE); + rp_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); rp_call.addParameter(flags, BY_VALUE); rp_call.addParameter(rp->hostreference.substr(1), BY_REFERENCE); @@ -949,7 +989,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq p_call.addParameter(f_type, BY_VALUE); p_call.addParameter(f_size, BY_VALUE); - p_call.addParameter(f_scale, BY_VALUE); + p_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); p_call.addParameter(flags, BY_VALUE); p_call.addParameter(p->hostreference.substr(1), BY_REFERENCE); @@ -1126,11 +1166,19 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq if (stmt->statementSource) { // statement source is a variable, we must check its type auto sv_name = stmt->statementSource->name.substr(1); if (!main_module_driver.field_exists(sv_name)) { - main_module_driver.error("Cannot find host variable: " + sv_name, ERR_MISSING_HOSTVAR, stmt->src_abs_path, current_input_line); + main_module_driver.error("Cannot find host variable: " + sv_name, ERR_MISSING_HOSTVAR, stmt->src_abs_path, stmt->startLine); return false; } cb_field_ptr sv = main_module_driver.field_map[sv_name]; bool is_varlen = get_actual_field_data(sv, &f_type, &f_size, &f_scale); + // If is_varlen is true, we are pointing to a "variable length group", which is fine. + // We pass the group and the runtime library will handle the "actual" data. + if (!is_varlen) { + if (sv->pictype != PIC_ALPHANUMERIC) { + main_module_driver.error("Unsupported type for host variable: " + sv_name, ERR_INVALID_TYPE, stmt->src_abs_path, stmt->startLine); + return false; + } + } ps_call.addParameter(&main_module_driver, stmt->statementSource); } @@ -1150,7 +1198,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq for (cb_hostreference_ptr p : *stmt->host_list) { ESQLCall p_call(get_call_id("SetSQLParams"), emit_static); if (!main_module_driver.field_exists(p->hostreference.substr(1))) { - main_module_driver.error("Cannot find host variable: " + p->hostreference.substr(1), ERR_MISSING_HOSTVAR, stmt->src_abs_path, current_input_line); + main_module_driver.error("Cannot find host variable: " + p->hostreference.substr(1), ERR_MISSING_HOSTVAR, stmt->src_abs_path, stmt->startLine); return false; } @@ -1162,7 +1210,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq p_call.addParameter(f_type, BY_VALUE); p_call.addParameter(f_size, BY_VALUE); - p_call.addParameter(f_scale, BY_VALUE); + p_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); p_call.addParameter(flags, BY_VALUE); p_call.addParameter(p->hostreference.substr(1), BY_REFERENCE); @@ -1188,8 +1236,25 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq ESQLCall ei_call(get_call_id("ExecImmediate"), emit_static); ei_call.addParameter("SQLCA", BY_REFERENCE); ei_call.addParameter(&main_module_driver, stmt->connectionId); - if (stmt->statementSource) + if (stmt->statementSource) { // statement source is a variable, we must check its type + auto sv_name = stmt->statementSource->name.substr(1); + if (!main_module_driver.field_exists(sv_name)) { + main_module_driver.error("Cannot find host variable: " + sv_name, ERR_MISSING_HOSTVAR, stmt->src_abs_path, current_input_line); + return false; + } + cb_field_ptr sv = main_module_driver.field_map[sv_name]; + bool is_varlen = get_actual_field_data(sv, &f_type, &f_size, &f_scale); + // If is_varlen is true, we are pointing to a "variable length group", which is fine. + // We pass the group and the runtime library will handle the "actual" data. + if (!is_varlen) { + if (sv->pictype != PIC_ALPHANUMERIC) { + main_module_driver.error("Unsupported type for host variable: " + sv_name, ERR_INVALID_TYPE, stmt->src_abs_path, current_input_line); + return false; + } + } + ei_call.addParameter(&main_module_driver, stmt->statementSource); + } else { ei_call.addParameter(string_format("SQ%04d", stmt->sql_query_list_id), BY_REFERENCE); ei_call.addParameter(0, BY_VALUE); @@ -1223,7 +1288,7 @@ bool TPESQLProcessing::handle_esql_stmt(const ESQL_Command cmd, const cb_exec_sq p_call.addParameter(f_type, BY_VALUE); p_call.addParameter(f_size, BY_VALUE); - p_call.addParameter(f_scale, BY_VALUE); + p_call.addParameter(f_scale > 0 ? -f_scale : 0, BY_VALUE); p_call.addParameter(flags, BY_VALUE); p_call.addParameter(p->hostreference.substr(1), BY_REFERENCE); @@ -1498,6 +1563,7 @@ bool TPESQLProcessing::fixup_declared_vars() cb_exec_sql_stmt_ptr stmt = new cb_exec_sql_stmt_t(); stmt->commandName = ESQL_DECLARE_VAR; stmt->src_file = filename_clean_path(var->defined_at_source_file); + stmt->src_abs_path = filename_absolute_path(var->defined_at_source_file); stmt->startLine = var->defined_at_source_line; stmt->endLine = var->defined_at_source_line; @@ -1511,6 +1577,7 @@ bool TPESQLProcessing::fixup_declared_vars() stmt = new cb_exec_sql_stmt_t(); stmt->commandName = ESQL_COMMENT; stmt->src_file = filename_clean_path(var->defined_at_source_file); + stmt->src_abs_path = filename_absolute_path(var->defined_at_source_file); stmt->startLine = orig_start_line; stmt->endLine = orig_end_line; diff --git a/libgixpp/TPESQLProcessing.h b/libgixpp/TPESQLProcessing.h index 5ac9920c..c8ae8817 100644 --- a/libgixpp/TPESQLProcessing.h +++ b/libgixpp/TPESQLProcessing.h @@ -70,6 +70,7 @@ class TPESQLProcessing : public ITransformationStep bool opt_consolidated_map; bool opt_no_output; bool opt_emit_map_file; + bool opt_emit_cobol85; gix_esql_driver main_module_driver; @@ -99,7 +100,7 @@ class TPESQLProcessing : public ITransformationStep void put_start_exec_sql(bool with_period); void put_end_exec_sql(bool with_period); - void put_query_defs(); + bool put_query_defs(); void put_working_storage(); bool put_cursor_declarations(); bool put_call(const ESQLCall &call, bool terminate_with_period); diff --git a/libgixpp/gix_esql_driver.hh b/libgixpp/gix_esql_driver.hh index cd7ca35c..67784649 100644 --- a/libgixpp/gix_esql_driver.hh +++ b/libgixpp/gix_esql_driver.hh @@ -55,6 +55,7 @@ USA. #define ERR_MISSING_LENGTH 19105 #define ERR_INVALID_TYPE 19106 #define ERR_FILE_NOT_FOUND 19107 +#define ERR_QUERY_TOO_LONG 19108 // This is used to keep the error code from nested function #define ERR_ALREADY_SET -9999 diff --git a/libgixpp/gix_esql_parser.yy b/libgixpp/gix_esql_parser.yy index 294c0753..50ea666e 100644 --- a/libgixpp/gix_esql_parser.yy +++ b/libgixpp/gix_esql_parser.yy @@ -68,6 +68,7 @@ static std::string to_std_string(const std::string s) { return s; } static std::string to_std_string(const std::vector *slp) { if (!slp) return "(NULL-LIST)"; int n = slp->size() > 3 ? 3 : slp->size(); std::string res; for (int i = 0; i < n; i++) res += slp->at(i); return (res + " ..."); } static std::string to_std_string(const int i) { char buffer [33]; sprintf(buffer, "%d", i); char *res = (char*) malloc(strlen(buffer) + 1); strcpy (res, buffer); return res; } static std::string to_std_string(hostref_or_literal_t *hl) { return hl->name; } +static std::string to_std_string(connect_to_info_t *i) { char buffer [33]; sprintf(buffer, "%d", i->type); char *res = (char*) malloc(strlen(buffer) + 1); strcpy (res, buffer); return res; } } @@ -158,6 +159,9 @@ static std::string to_std_string(hostref_or_literal_t *hl) { return hl->name; } %token ALL %token OCCURS %token UNBOUNDED +%token DEPENDING_ON +%token ASCENDING_KEY_IS +%token INDEXED_BY %token EXTERNAL %token TIMES %token CONST @@ -178,6 +182,8 @@ static std::string to_std_string(hostref_or_literal_t *hl) { return hl->name; } %type opt_with_hold %type opt_sql_type_def sql_type +%type opt_auth_info opt_identified_by + %nonassoc error // No %destructors are needed, since memory will be reclaimed by the @@ -334,23 +340,84 @@ EXECSQL unexpected_at OPEN expr END_EXEC { } connectsql: +// mode 1/2-6 : // EXEC SQL CONNECT TO :db_data_source [ AS :db_conn_id ] USER :username.:opt_password [ USING password ]; -EXECSQL CONNECT TO strliteral_or_hostref opt_connect_as USER strliteral_or_hostref opt_using END_EXEC { +// EXEC SQL CONNECT TO :dbname [ AS :db_conn_id ] USER :username USING :db_data_source IDENTIFIED BY :password +EXECSQL CONNECT TO strliteral_or_hostref opt_connect_as USER strliteral_or_hostref opt_auth_info END_EXEC { driver.conninfo = new esql_connection_info_t(); - driver.conninfo->id = $5; - driver.conninfo->data_source = $4; - driver.conninfo->username = $7; - driver.conninfo->password = $8; + + switch ($8->type) { + case 0: // [ USING :password ] omitted + driver.conninfo->id = $5; + driver.conninfo->data_source = $4; + driver.conninfo->username = $7; + driver.conninfo->password = new hostref_or_literal_t(); + driver.conninfo->dbname = new hostref_or_literal_t(); + break; + + case 1: // USING :password (no IDENTIFIED BY... follows) + driver.conninfo->id = $5; + driver.conninfo->data_source = $4; + driver.conninfo->username = $7; + driver.conninfo->password = $8->t1; + driver.conninfo->dbname = new hostref_or_literal_t(); + break; + + case 2: // USING :db_data_source IDENTIFIED BY :password + driver.conninfo->id = $5; + driver.conninfo->data_source = $8->t1; + driver.conninfo->username = $7; + driver.conninfo->password = $8->t2; + driver.conninfo->dbname = $4; + break; + + } + driver.put_exec_list(); } -// EXEC SQL CONNECT :username IDENTIFIED BY :password [ AT :db_conn_id ] USING :db_data_source -| EXECSQL CONNECT strliteral_or_hostref IDENTIFIED_BY strliteral_or_hostref opt_at USING strliteral_or_hostref END_EXEC { +// mode 3/4: EXEC SQL CONNECT :username IDENTIFIED BY :password [ AT :db_conn_id ] [ USING :db_data_source] (mode 4 is unsupported) +| EXECSQL CONNECT strliteral_or_hostref IDENTIFIED_BY strliteral_or_hostref opt_at opt_using END_EXEC { + if (!$7->is_set) { + driver.warning(@$, "Unsupported connection mode, data source information not provided. Connection will fail."); + } + driver.conninfo = new esql_connection_info_t(); driver.conninfo->id = $6; - driver.conninfo->data_source = $8; + driver.conninfo->data_source = $7; driver.conninfo->username = $3; driver.conninfo->password = $5; driver.put_exec_list(); + +} +// mode 5: EXEC SQL CONNECT USING :db_data_source (credentials must be embedded to be able to connect) +| EXECSQL CONNECT USING strliteral_or_hostref END_EXEC { + driver.conninfo = new esql_connection_info_t(); + driver.conninfo->data_source = $4; + driver.put_exec_list(); +} +; + +opt_auth_info: +%empty { $$ = new connect_to_info_t(); $$->type = 0; } +| USING strliteral_or_hostref opt_identified_by { + if ($3 == nullptr) { + $$ = new connect_to_info_t(); + $$->type = 1; + $$->t1 = $2; + } + else { + $$ = $3; + $$->t1 = $2; + } +} +; + +opt_identified_by: +%empty { $$ = nullptr; } +| IDENTIFIED_BY strliteral_or_hostref { + $$ = new connect_to_info_t(); + $$->type = 2; + $$->t2 = $2; } ; @@ -803,13 +870,46 @@ flag_separate: ; occurs_clause: -OCCURS NUMERIC _times -{ - driver.current_field->occurs = (int)$2; -} -| OCCURS UNBOUNDED { - driver.current_field->occurs = -1; -} +OCCURS NUMERIC occurs_numeric_data occurs_sort_opts +| OCCURS UNBOUNDED occurs_unbounded_data occurs_sort_opts +; + +occurs_numeric_data: +TO numeric_or_word TIMES DEPENDING_ON WORD +| DEPENDING_ON WORD +| TIMES opt_depending_on +| %empty +; + +opt_depending_on: +%empty +| DEPENDING_ON WORD +; + +occurs_unbounded_data: +%empty +| NUMERIC TIMES DEPENDING_ON TOKEN +| DEPENDING_ON WORD +; + +occurs_sort_opts: +opt_ascending_key_is opt_indexed_by +; + +opt_ascending_key_is: +%empty +| ASCENDING_KEY_IS WORD +; + +opt_indexed_by: +%empty +| INDEXED_BY WORD +; + + +numeric_or_word: +NUMERIC +| WORD ; external_clause: @@ -819,7 +919,6 @@ _is EXTERNAL {} _is: %empty | IS; _is_are: %empty | IS | ARE; _all: %empty | ALL; -_times: %empty | TIMES; %% diff --git a/libgixpp/gix_esql_scanner.ll b/libgixpp/gix_esql_scanner.ll index 45e2a490..e66942cc 100644 --- a/libgixpp/gix_esql_scanner.ll +++ b/libgixpp/gix_esql_scanner.ll @@ -83,10 +83,14 @@ const char *GixEsqlLexer::yy_state_descs[NUM_YY_STATES] = { "INITIAL", "PICTURE_ %option yylineno %option stack +/* This works around a win-flex + MSVC bug (unnecessary warnings about macro redefinitions) */ +%top{ +#include +} /* Regex abbreviations: */ -%s PICTURE_STATE DATA_DIVISION_STATE +%s PICTURE_STATE DATA_DIVISION_STATE %x ESQL_FUNC_STATE ESQL_INCLUDE_STATE ESQL_SELECT_STATE ESQL_STATE INCLUDE_STATE FD_STATE ESQL_DBNAME_STATE VAR_DECLARE_STATE ESQL_PREPARE_STATE ESQL_DECLARE_STATE ESQL_EXECUTE_STATE ESQL_CONNECT_STATE ESQL_IGNORE_STATE @@ -103,6 +107,7 @@ OP_CHARS [\~\!\@\#\^\&\|\`\?\+\-\*\/\%\<\>\=] OPERATOR {OP_CHARS}+ COMPARISON "="|"<>"|"<"|">"|"<="|">=" COMMA "," +PG_CASTOP "::" HOSTWORD ":"([A-Za-z\-0-9_]*([\xA0-\xDF]|([\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]))*[A-Za-z\-0-9_]*) INT_CONSTANT {digit}+ LOW_VALUE "LOW\-VALUE" @@ -139,7 +144,7 @@ LOW_VALUE "LOW\-VALUE" __yy_push_state(DATA_DIVISION_STATE); } -"WORKING-STORAGE"[ ]+"SECTION"[ ]*"." | +"WORKING-STORAGE"[ ]+"SECTION"[ ]*"." | "LOCAL-STORAGE"[ ]+"SECTION"[ ]*"." | "LINKAGE"[ ]+"SECTION"[ ]*"." | "FILE"[ ]+"SECTION"[ ]*"." { @@ -744,6 +749,10 @@ LOW_VALUE "LOW\-VALUE" return yy::gix_esql_parser::make_TOKEN(yytext, loc); } + {PG_CASTOP} { + return yy::gix_esql_parser::make_TOKEN(yytext, loc); + } + /* {FILENAME} { driver.hostlineno = yylineno; @@ -1165,8 +1174,6 @@ LOW_VALUE "LOW\-VALUE" ("66"|"77"|"78"|"88")[^\.]*"." {} "OBJECT-STORAGE"[ ]+"SECTION"[ ]*"." | - /*"LOCAL-STORAGE"[ ]+"SECTION"[ ]*"." | - "FILE"[ ]+"SECTION"[ ]*"." | */ "COMMUNICATION"[ ]+"SECTION"[ ]*"." | "REPORT"[ ]+"SECTION"[ ]*"." | "SCREEN"[ ]+"SECTION"[ ]*"." { @@ -1209,6 +1216,22 @@ LOW_VALUE "LOW\-VALUE" return yy::gix_esql_parser::make_UNBOUNDED(loc); } + "TO" { + return yy::gix_esql_parser::make_TO(loc); + } + + "DEPENDING"[ \r\n]+"ON" { + return yy::gix_esql_parser::make_DEPENDING_ON(loc); + } + + "ASCENDING"[ \r\n]+"KEY"[ \r\n]+"IS" { + return yy::gix_esql_parser::make_ASCENDING_KEY_IS(loc); + } + + "INDEXED"[ \r\n]+"BY" { + return yy::gix_esql_parser::make_INDEXED_BY(loc); + } + ([0-9]+)|([0-9]+\.[0-9]+) { return yy::gix_esql_parser::make_NUMERIC(atoi(yytext), loc); } diff --git a/libgixpp/libgixpp.h b/libgixpp/libgixpp.h index 2ac68097..8611f466 100644 --- a/libgixpp/libgixpp.h +++ b/libgixpp/libgixpp.h @@ -1,3 +1,3 @@ #pragma once -#define LIBGIXPP_VER "1.0.11a" +#define LIBGIXPP_VER "1.0.11b"