Skip to main content

Good morning.

My organization is in the process of upgrading from Visual COBOL 3 to Visual COBOL 7. We works with VC for eclipse runing on UNIX.

When we are compiled the programs this error appear CSQL-F-026

The code of the program is :

identification division.

       program-id. desacomp.

       author. arquitectura.

       date-written. date.

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

      *              Programa de prueba para fallos de compilacion     *

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

       environment division.

       configuration section.

       special-names.

          decimal-point is comma.

       input-output section.

       working-storage section.

 

           exec sql include tabdes   end-exec.

 

           exec sql BEGIN DECLARE SECTION

           end-exec.

      *----variables Host

       01  sql-var2               PIC X(120).

           exec sql END DECLARE SECTION

           end-exec.

 

           copy 'cwdesacomp'.

 

       linkage section.

 

       procedure division .

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

               exec sql

                  select  desdes

                    into :sql-var2

                  from tabdes

                    where descod = 'DIV'

                      and desdes [62,62] = '*'

               end-exec

               move sqlcode    to wk-variable2

               if sqlcode= 1

                  move 'OK'    to  wk-variable1

               else

                  move 'KO'    to  wk-variable1

               end-if

 

               stop run

           .

Code of tabdes  include:

       EXEC SQL BEGIN DECLARE SECTION END-EXEC.

       01 TABDES.

          02 DESCOD        PIC X(3).

          02 DESCLA        PIC X(15).

          02 DESDES        PIC X(186).

       EXEC SQL END DECLARE SECTION END-EXEC.

Code of cwdesacomp copy :

       01  wk-variable1            pic x(2).

       01  wk-variable2            pic 9(4).

 

This works well in our Visual COBOL v3 (Informix + AIX 7.1).

 

And it works well when we add a newline after "end-exec." and before the comnet line "*----variables Host." or  when whe write  “exec sql BEGIN DECLARE SECTION end-exec.” in a unique line.

Many other options were tried, but the summary is that we wish to recover the behavior we had in VC v3 because we have a lot of programs with this kind of source .

Is there some compilation option/directive/whatever to make this version 7 behave like the old one?

 

Thanks,

Good morning.

My organization is in the process of upgrading from Visual COBOL 3 to Visual COBOL 7. We works with VC for eclipse runing on UNIX.

When we are compiled the programs this error appear CSQL-F-026

The code of the program is :

identification division.

       program-id. desacomp.

       author. arquitectura.

       date-written. date.

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

      *              Programa de prueba para fallos de compilacion     *

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

       environment division.

       configuration section.

       special-names.

          decimal-point is comma.

       input-output section.

       working-storage section.

 

           exec sql include tabdes   end-exec.

 

           exec sql BEGIN DECLARE SECTION

           end-exec.

      *----variables Host

       01  sql-var2               PIC X(120).

           exec sql END DECLARE SECTION

           end-exec.

 

           copy 'cwdesacomp'.

 

       linkage section.

 

       procedure division .

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

               exec sql

                  select  desdes

                    into :sql-var2

                  from tabdes

                    where descod = 'DIV'

                      and desdes [62,62] = '*'

               end-exec

               move sqlcode    to wk-variable2

               if sqlcode= 1

                  move 'OK'    to  wk-variable1

               else

                  move 'KO'    to  wk-variable1

               end-if

 

               stop run

           .

Code of tabdes  include:

       EXEC SQL BEGIN DECLARE SECTION END-EXEC.

       01 TABDES.

          02 DESCOD        PIC X(3).

          02 DESCLA        PIC X(15).

          02 DESDES        PIC X(186).

       EXEC SQL END DECLARE SECTION END-EXEC.

Code of cwdesacomp copy :

       01  wk-variable1            pic x(2).

       01  wk-variable2            pic 9(4).

 

This works well in our Visual COBOL v3 (Informix + AIX 7.1).

 

And it works well when we add a newline after "end-exec." and before the comnet line "*----variables Host." or  when whe write  “exec sql BEGIN DECLARE SECTION end-exec.” in a unique line.

Many other options were tried, but the summary is that we wish to recover the behavior we had in VC v3 because we have a lot of programs with this kind of source .

Is there some compilation option/directive/whatever to make this version 7 behave like the old one?

 

Thanks,

Try to set the directive for VC:

    set SQL(dbman=odbc) SQL(BEHAVIOR=OPTIMIZED)

i have no problem with sql and visual cobol from version 3,4,5,6,7,8

if this will not help, post your complete code from this example and give us the possibility to test quickly on our system

What os do you have? Win7, win10 or win11

what service pack for vc7?

cg


Good morning.

My organization is in the process of upgrading from Visual COBOL 3 to Visual COBOL 7. We works with VC for eclipse runing on UNIX.

When we are compiled the programs this error appear CSQL-F-026

The code of the program is :

identification division.

       program-id. desacomp.

       author. arquitectura.

       date-written. date.

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

      *              Programa de prueba para fallos de compilacion     *

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

       environment division.

       configuration section.

       special-names.

          decimal-point is comma.

       input-output section.

       working-storage section.

 

           exec sql include tabdes   end-exec.

 

           exec sql BEGIN DECLARE SECTION

           end-exec.

      *----variables Host

       01  sql-var2               PIC X(120).

           exec sql END DECLARE SECTION

           end-exec.

 

           copy 'cwdesacomp'.

 

       linkage section.

 

       procedure division .

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

               exec sql

                  select  desdes

                    into :sql-var2

                  from tabdes

                    where descod = 'DIV'

                      and desdes [62,62] = '*'

               end-exec

               move sqlcode    to wk-variable2

               if sqlcode= 1

                  move 'OK'    to  wk-variable1

               else

                  move 'KO'    to  wk-variable1

               end-if

 

               stop run

           .

Code of tabdes  include:

       EXEC SQL BEGIN DECLARE SECTION END-EXEC.

       01 TABDES.

          02 DESCOD        PIC X(3).

          02 DESCLA        PIC X(15).

          02 DESDES        PIC X(186).

       EXEC SQL END DECLARE SECTION END-EXEC.

Code of cwdesacomp copy :

       01  wk-variable1            pic x(2).

       01  wk-variable2            pic 9(4).

 

This works well in our Visual COBOL v3 (Informix + AIX 7.1).

 

And it works well when we add a newline after "end-exec." and before the comnet line "*----variables Host." or  when whe write  “exec sql BEGIN DECLARE SECTION end-exec.” in a unique line.

Many other options were tried, but the summary is that we wish to recover the behavior we had in VC v3 because we have a lot of programs with this kind of source .

Is there some compilation option/directive/whatever to make this version 7 behave like the old one?

 

Thanks,

Good morning.

A couple of questions.

1. Did you change anything besides the COBOL product version such as the OS or the Informix precompiler?

2. Are you using the same compiler and precompiler directives files that you may have been using with V3.0?

3. Are you on the latest Patch Update for 7.0? This would be Patch Update 10?

Thanks.


Good morning.

A couple of questions.

1. Did you change anything besides the COBOL product version such as the OS or the Informix precompiler?

2. Are you using the same compiler and precompiler directives files that you may have been using with V3.0?

3. Are you on the latest Patch Update for 7.0? This would be Patch Update 10?

Thanks.

hi,

1  same AIX, same Informix, same computer

2  no change

3  ./cob -V
version @(#)cob.c       7.0.0.105
PRN=KXCAI/AAD:Ao.U4.13.04
PTI=32/64 bit
PTI=Micro Focus Visual COBOL Development Hub 7.0 - Patch Update 09
PTI=Patch Update 09
PTI=pkg_303063
PTI=MFInstaller

Thanks,

Albert


Good morning.

A couple of questions.

1. Did you change anything besides the COBOL product version such as the OS or the Informix precompiler?

2. Are you using the same compiler and precompiler directives files that you may have been using with V3.0?

3. Are you on the latest Patch Update for 7.0? This would be Patch Update 10?

Thanks.

hi again... I downloaded VC  v4 patch update 29 (setup_visualcobol_devhub_4.0_patchupdate29_304962_aix_systemp) and installed it. The compilation fails too, is something that started after our v3 patch level, 06.

thanks,

albert


hi again... I downloaded VC  v4 patch update 29 (setup_visualcobol_devhub_4.0_patchupdate29_304962_aix_systemp) and installed it. The compilation fails too, is something that started after our v3 patch level, 06.

thanks,

albert

We have tested this on a system here and we were able to reproduce the error. It appears to be a problem with the cobsql preprocessor. I do not currently know of a workaround other than changing the source but I will continue to investigate. Could you please open up a support case for this and then we can create a defect report for the problem so that we can get it fixed? If you mention my name when opening the case then it will be directed to me.

Thanks


We have tested this on a system here and we were able to reproduce the error. It appears to be a problem with the cobsql preprocessor. I do not currently know of a workaround other than changing the source but I will continue to investigate. Could you please open up a support case for this and then we can create a defect report for the problem so that we can get it fixed? If you mention my name when opening the case then it will be directed to me.

Thanks

hi, thanks, I opened yesterday a ticket for both problems, CSQL-F-026 & 225-S Level hierarchy wrong, ticket #02380790.

thanks,

albert