Re: Strange syntax error

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

 



Hi Leslie,

Am 15.05.2018 um 16:13 schrieb Leslie Turriff:
> Hi,
> 	It's been a while since I tinkered with GnuCOBOL (back when it was OpenCOBOL, 
> actually), so I might be missing something really simple here.
> 	I'm trying to install the cobcurses package on my OpenSuSE Linux x86_64 
> system, and getting these errors.  The source code looks simple enough, so 
> I'm not sure what's causing them.
> 
> Source code:
> 
> ~/Downloads/Packages/Non-RPMs/Linux/cobcurses/src
> $ head -n24 lib/libcobcurses.cob |cat -n
>      1  *>*****************************************************************
>      2  *>
>      3  *>     LIBCOBCURSES : CODE FOR SHARED LIBRARY
>      4  *>
>      5  *>     Warren W. Gay VE3WWG
>      6  *>
>      7  *>*****************************************************************
>      8
>      9  *>*****************************************************************
>     10  *>     INITIALIZATION ROUTINE "libcobcurses" :
>     11  *>*****************************************************************
>     12
>     13  IDENTIFICATION DIVISION.
>     14  PROGRAM-ID. libcobcurses.
>     15
>     16  DATA DIVISION.
>     17  WORKING-STORAGE SECTION.
>     18
>     19  01  NC-COBCURSES-EXIT.
>     20      10  NC-INSTALL-FLAG                 PIC 9999 COMP-5 VALUE 0.
>     21  01  NC-EXIT-PROC                        USAGE IS PROGRAM-POINTER.
>     22  01  WS-COBCURSES-NORECOVERY-VALUE       PIC X VALUE 'N'.
>     23
>     24  LINKAGE SECTION.
> 
> 	The make process does this:
> 
> cobc -b -Wall -Wno-call-params  -std=cobol85 -I../copybk -free 
> libcobcurses.cob cobcurses.o terminal.o term_curses.o term_curses_con
> v.o term_curses_menu.o cc_menu.o environ.o misc.o dynstr.o pathname.o fcomp2.o 
> ecomp1.o ecomp2.o expon.o ecvt.o units.o eunits.o enu
> mber.o cobmenu.o cobtrace.o -L/usr/local/lib64  -lncurses
> 
> and produces error messages like these.  Most of them appear to be cascade 
> errors caused by the first on on line 20. The COBCURSG.cbl copybook is quite 
> large, and the compiler gives up after a while and the make fails.
> 
> libcobcurses.cob:20: error: syntax error, unexpected Identifier, expecting 
> EXTERNAL or EXTERNAL-FORM or GLOBAL or IDENTIFIED
> libcobcurses.cob:21: error: syntax error, unexpected Identifier
> ../copybk/COBCURSG.cbl:12: error: syntax error, unexpected Identifier, 
> expecting EXTERNAL or EXTERNAL-FORM or GLOBAL or IDENTIFIED
> 
> 	I can't see what's causing this.  I'm attaching the complete program and 
> copybook sources and the make log in hopes you can see what's wrong.

This was not easy to spot on the first look, but it is "correct":
COMP-5 is not defined in COBOL 1985, same for POINTER, PROGRAM-POINTER,...


One of the big changes between GnuCOBOL 1.1 and 2.2 is that GnuCOBOL
take you serious when you specify you want to do COBOL85 only and not
use any other features (including reserved words and therefore USAGEs,
too) that are not available in the chosen std.


You *could* add these specific words on the command line with a "single"
option:

  cobc -std=cobol85 -freserved=COMP-5,POINTER,PROGRAM-POINTER prog.cob

or add all available reserved words:

  cobc -std=cobol85 -freserved-words=default prog.cob

but you likely don't want to go this route.


>From the sources sent it is obvious that these aren't wrote for COBOL85
(or any other standard COBOL dialect), I suggest to remove the -std from
the Makefiles completely and only remove possible offending words like

   -fnot-reserved=RESTRICT,HANDLE,NOTHING


Note: In many other places cobc already leaves a hint about this. As it
is likely helpful I've just added this for the USAGEs, too (only
possible as long as "USAGE" is explicit coded), changing the second
error message:

 libcobcurses.cob:20: error: syntax error, unexpected Identifier,
     expecting EXTERNAL or EXTERNAL-FORM or GLOBAL or IDENTIFIED
-libcobcurses.cob:21: error: syntax error, unexpected Identifier
+libcobcurses.cob:21: error: 'PROGRAM-POINTER' is not defined, but is a
+   reserved word in another dialect
 ../copybk/COBCURSG.CBL:12: error: syntax error, unexpected Identifier,
    expecting EXTERNAL or EXTERNAL-FORM or GLOBAL or IDENTIFIED

> Leslie


Simon




[Index of Archives]     [Gcc Help]     [Linux USB Devel]     [Linux Audio Users]     [Yosemite Info]     [Linux Kernel]     [Linux SCSI]     [Big List of Linux Books]

  Powered by Linux